Released PSJ*5*331 SEQ #288
Extracted from mail message
**KIDS**:PSJ*5.0*331^
**INSTALL NAME**
PSJ*5.0*331
"BLD",10228,0)
PSJ*5.0*331^INPATIENT MEDICATIONS^0^3160922^y
"BLD",10228,1,0)
^^6^6^3160726^
"BLD",10228,1,1,0)
This patch will resolve the following issues:
"BLD",10228,1,2,0)
1) Label for Clinic infusion for Inpatient is printing the ward and
"BLD",10228,1,3,0)
not the clinic
"BLD",10228,1,4,0)
2) Metric Conversion for Patients Weight consistency
"BLD",10228,1,5,0)
3) Leading zero dropped between CPRS and VistA for IV solution
"BLD",10228,1,6,0)
4) Appending to infusion rate incorrectly
"BLD",10228,4,0)
^9.64PA^^
"BLD",10228,6.3)
15
"BLD",10228,"ABPKG")
n
"BLD",10228,"KRN",0)
^9.67PA^779.2^20
"BLD",10228,"KRN",.4,0)
.4
"BLD",10228,"KRN",.401,0)
.401
"BLD",10228,"KRN",.402,0)
.402
"BLD",10228,"KRN",.403,0)
.403
"BLD",10228,"KRN",.5,0)
.5
"BLD",10228,"KRN",.84,0)
.84
"BLD",10228,"KRN",3.6,0)
3.6
"BLD",10228,"KRN",3.8,0)
3.8
"BLD",10228,"KRN",9.2,0)
9.2
"BLD",10228,"KRN",9.8,0)
9.8
"BLD",10228,"KRN",9.8,"NM",0)
^9.68A^6^6
"BLD",10228,"KRN",9.8,"NM",1,0)
PSIVLABL^^0^B43876425
"BLD",10228,"KRN",9.8,"NM",2,0)
PSIVSP^^0^B42970489
"BLD",10228,"KRN",9.8,"NM",3,0)
PSJAC^^0^B18714704
"BLD",10228,"KRN",9.8,"NM",4,0)
PSJHL4A^^0^B64737750
"BLD",10228,"KRN",9.8,"NM",5,0)
PSJLMHED^^0^B56836733
"BLD",10228,"KRN",9.8,"NM",6,0)
PSIVLABR^^0^B40125605
"BLD",10228,"KRN",9.8,"NM","B","PSIVLABL",1)
"BLD",10228,"KRN",9.8,"NM","B","PSIVLABR",6)
"BLD",10228,"KRN",9.8,"NM","B","PSIVSP",2)
"BLD",10228,"KRN",9.8,"NM","B","PSJAC",3)
"BLD",10228,"KRN",9.8,"NM","B","PSJHL4A",4)
"BLD",10228,"KRN",9.8,"NM","B","PSJLMHED",5)
"BLD",10228,"KRN",19,0)
19
"BLD",10228,"KRN",19.1,0)
19.1
"BLD",10228,"KRN",19.1,"NM",0)
^9.68A^^
"BLD",10228,"KRN",101,0)
101
"BLD",10228,"KRN",101,"NM",0)
^9.68A^^0
"BLD",10228,"KRN",409.61,0)
409.61
"BLD",10228,"KRN",409.61,"NM",0)
^9.68A^^0
"BLD",10228,"KRN",771,0)
771
"BLD",10228,"KRN",779.2,0)
779.2
"BLD",10228,"KRN",870,0)
870
"BLD",10228,"KRN",8989.51,0)
8989.51
"BLD",10228,"KRN",8989.52,0)
8989.52
"BLD",10228,"KRN",8994,0)
8994
"BLD",10228,"KRN","B",.4,.4)
"BLD",10228,"KRN","B",.401,.401)
"BLD",10228,"KRN","B",.402,.402)
"BLD",10228,"KRN","B",.403,.403)
"BLD",10228,"KRN","B",.5,.5)
"BLD",10228,"KRN","B",.84,.84)
"BLD",10228,"KRN","B",3.6,3.6)
"BLD",10228,"KRN","B",3.8,3.8)
"BLD",10228,"KRN","B",9.2,9.2)
"BLD",10228,"KRN","B",9.8,9.8)
"BLD",10228,"KRN","B",19,19)
"BLD",10228,"KRN","B",19.1,19.1)
"BLD",10228,"KRN","B",101,101)
"BLD",10228,"KRN","B",409.61,409.61)
"BLD",10228,"KRN","B",771,771)
"BLD",10228,"KRN","B",779.2,779.2)
"BLD",10228,"KRN","B",870,870)
"BLD",10228,"KRN","B",8989.51,8989.51)
"BLD",10228,"KRN","B",8989.52,8989.52)
"BLD",10228,"KRN","B",8994,8994)
"BLD",10228,"QDEF")
^^^^NO
"BLD",10228,"QUES",0)
^9.62^^
"BLD",10228,"REQB",0)
^9.611^3^2
"BLD",10228,"REQB",2,0)
PSJ*5.0*313^2
"BLD",10228,"REQB",3,0)
PSJ*5.0*305^2
"BLD",10228,"REQB","B","PSJ*5.0*305",3)
"BLD",10228,"REQB","B","PSJ*5.0*313",2)
"MBREQ")
0
"PKG",471,-1)
1^1
"PKG",471,0)
INPATIENT MEDICATIONS^PSJ^UNIT DOSE AND IVS
"PKG",471,20,0)
^9.402P^^
"PKG",471,22,0)
^9.49I^1^1
"PKG",471,22,1,0)
5.0^2971215^2990325^66481
"PKG",471,22,1,"PAH",1,0)
331^3160922
"PKG",471,22,1,"PAH",1,1,0)
^^6^6^3160922
"PKG",471,22,1,"PAH",1,1,1,0)
This patch will resolve the following issues:
"PKG",471,22,1,"PAH",1,1,2,0)
1) Label for Clinic infusion for Inpatient is printing the ward and
"PKG",471,22,1,"PAH",1,1,3,0)
not the clinic
"PKG",471,22,1,"PAH",1,1,4,0)
2) Metric Conversion for Patients Weight consistency
"PKG",471,22,1,"PAH",1,1,5,0)
3) Leading zero dropped between CPRS and VistA for IV solution
"PKG",471,22,1,"PAH",1,1,6,0)
4) Appending to infusion rate incorrectly
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")
"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
6
"RTN","PSIVLABL")
0^1^B43876425^B43882246
"RTN","PSIVLABL",1,0)
PSIVLABL ;BIR/PR - PRINT OUT LABELS ; 8/19/09 3:00pm
"RTN","PSIVLABL",2,0)
;;5.0;INPATIENT MEDICATIONS;**58,82,104,127,178,184,273,279,331**;16 DEC 97;Build 15
"RTN","PSIVLABL",3,0)
;
"RTN","PSIVLABL",4,0)
; Reference to ^%ZIS(2 is supported by DBIA 3435.
"RTN","PSIVLABL",5,0)
; Reference to ^PS(52.6 is supported by DBIA 1231.
"RTN","PSIVLABL",6,0)
; Reference to ^PS(52.7 is supported by DBIA 2173.
"RTN","PSIVLABL",7,0)
; Reference to ^PS(55 is supported by DBIA 2191.
"RTN","PSIVLABL",8,0)
; Reference to ^PS(51.2 is supported by DBIA 2178.
"RTN","PSIVLABL",9,0)
;
"RTN","PSIVLABL",10,0)
;Needs DFN,ON, and PSIVNOL NOTE: If PSIVCT is defined then we do
"RTN","PSIVLABL",11,0)
;not count labels in the STATs file or increment cummulative doses or
"RTN","PSIVLABL",12,0)
;the last fill field.
"RTN","PSIVLABL",13,0)
;PSIVCT will be defined if reprinting scheduled labels, the suspense
"RTN","PSIVLABL",14,0)
;list, or if printing individual labels and they do not count.
"RTN","PSIVLABL",15,0)
;
"RTN","PSIVLABL",16,0)
DEM ;Get demographics and see if label is example only
"RTN","PSIVLABL",17,0)
N X0,PSJIO,I,PSIVCLIN,PSIVCLDT,PSIVCLAB
"RTN","PSIVLABL",18,0)
S I=0 F S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I S X0=$G(^(I,0)) I X0]"" S PSJIO($P(X0,"^"))=^(1)
"RTN","PSIVLABL",19,0)
S PSJIO=$S('$D(PSJIO):0,1:1)
"RTN","PSIVLABL",20,0)
S PSIVCLIN=$G(^PS(55,DFN,"IV",+ON,"DSS")) S:'(PSIVCLIN>0) PSIVCLIN="" I PSIVCLIN D
"RTN","PSIVLABL",21,0)
.S PSIVCLDT=$P(PSIVCLIN,"^",2) S $P(PSIVCLIN,"^",2)=$P($G(^SC(+PSIVCLIN,0)),"^")
"RTN","PSIVLABL",22,0)
I $G(PSIVCLIN) S PSIVCLAB=$P($G(^SC(+PSIVCLIN,0)),"^",2)
"RTN","PSIVLABL",23,0)
D ENIV^PSJAC,NOW^%DTC S PSIVNOW=$$ENDTC^PSGMI(%),VADM(2)=$E(VADM(2),6,9)
"RTN","PSIVLABL",24,0)
S PSIVWD=$S((+VAIN(4)&'$G(PSIVCLDT)):$P(VAIN(4),U,2),$G(PSIVCLIN)&($G(PSIVCLAB)]""):PSIVCLAB,$G(PSIVCLIN)&($P($G(PSIVCLIN),"^",2)]""):$P(PSIVCLIN,"^",2),1:"Opt. IV") I $D(PSIVEXAM) G ENX
"RTN","PSIVLABL",25,0)
;
"RTN","PSIVLABL",26,0)
G:PSIVNOL<1 Q D SETP S PSIVRM=$P(PSIVSITE,U,13),P16=$P($G(^PS(55,DFN,"IV",+ON,9)),U,3) S:PSIVRM<1 PSIVRM=30 I $D(PSIVCT),PSIVCT'=1 K PSIVCT
"RTN","PSIVLABL",27,0)
I PSJIO,$G(PSJIO("FI"))]"" X PSJIO("FI")
"RTN","PSIVLABL",28,0)
I $P(PSIVSITE,U,7) D
"RTN","PSIVLABL",29,0)
. S PSIVFLAG=1,(LINE,PSIV1)=0,PSIV2=PSIVNOL,PSIVNOL=0 D RE
"RTN","PSIVLABL",30,0)
. S PSIVRP="",PSIVRT=""
"RTN","PSIVLABL",31,0)
. I $D(^PS(55,DFN,"IV",+ON,.2)) S PSIVRP=$P(^PS(55,DFN,"IV",+ON,.2),U,3) D
"RTN","PSIVLABL",32,0)
.. I PSIV1'>0!'$P(PSIVSITE,U,3)!($P(PSIVSITE,U,3)=1&(P(4)'="P"))!($P(PSIVSITE,U,3)=2&("AH"'[P(4))) Q ;DO NOT PRINT ROUTE IF "DOSE DUE AT" IS SET TO NOT PRINT.
"RTN","PSIVLABL",33,0)
.. S PSIVRT=$P(^PS(51.2,PSIVRP,0),U,1)
"RTN","PSIVLABL",34,0)
.. S X="ROUTE: "_PSIVRT D:X]"" PMR
"RTN","PSIVLABL",35,0)
. S X="Solution: _______________" D P S X="Additive: _______________" D P
"RTN","PSIVLABL",36,0)
. S PSIVNOL=PSIV2
"RTN","PSIVLABL",37,0)
. I 'PSJIO F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
"RTN","PSIVLABL",38,0)
. I PSJIO,$G(PSJIO("EL"))]"" X PSJIO("EL")
"RTN","PSIVLABL",39,0)
I '$D(PSIVCT) D NOW^%DTC S Y=%,$P(^PS(55,DFN,"IV",+ON,9),U,1,2)=Y_"^"_PSIVNOL,$P(^(9),U,3)=$P(^(9),U,3)+PSIVNOL
"RTN","PSIVLABL",40,0)
K PSIVFLAG,PSIVSH G START
"RTN","PSIVLABL",41,0)
SETP S Y=^PS(55,DFN,"IV",+ON,0) F X=1:1:23 S P(X)=$P(Y,U,X)
"RTN","PSIVLABL",42,0)
Q
"RTN","PSIVLABL",43,0)
ENX ;Print example label
"RTN","PSIVLABL",44,0)
D SETP S PSIVFLAG=1,PSIVRM=$P(PSIVSITE,U,13) S:PSIVRM<1 PSIVRM=30
"RTN","PSIVLABL",45,0)
START F PSIV1=1:1:PSIVNOL D
"RTN","PSIVLABL",46,0)
. S LINE=0 D RE
"RTN","PSIVLABL",47,0)
. Q:$D(PSIVFLAG)
"RTN","PSIVLABL",48,0)
. I 'PSJIO F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
"RTN","PSIVLABL",49,0)
. I PSJIO,$G(PSJIO("EL"))]"" X PSJIO("EL")
"RTN","PSIVLABL",50,0)
I PSJIO,$G(PSJIO("FE"))]"" X PSJIO("FE")
"RTN","PSIVLABL",51,0)
D:'$D(PSIVCT) ^PSIVSTAT
"RTN","PSIVLABL",52,0)
Q K PSIV,PSIVDOSE,PSIVWD,P16,LINE,MESS,PSIVCT,PSIV2,PSIVFLAG,PSIVRM,PSIV1,PDOSE,PDATE,XX1,XX2,BAG,CX,PSIMESS Q
"RTN","PSIVLABL",53,0)
RE ;
"RTN","PSIVLABL",54,0)
K DO
"RTN","PSIVLABL",55,0)
;*273 - Bottle values for chemo admixture IVs
"RTN","PSIVLABL",56,0)
N PSIVADTYPE I (P(4)="A")!($P($G(^PS(55,DFN,"IV",+ON,0)),U,23)="A") S PSIVADTYPE=1
"RTN","PSIVLABL",57,0)
I PSIV1,$G(PSIVADTYPE)!(P(5)=0) S P(16)=PSIV1 I $G(PSIVT)]"" D
"RTN","PSIVLABL",58,0)
. S:P(15)>2880!('P(15)) P(15)=2880 S P(16)=P16+PSIV1#(1440/P(15)+.5\1) S:'P(16) P(16)=PSIV1
"RTN","PSIVLABL",59,0)
I PSIV1 S PSJBCID=$$BCMA^PSIVBCID(DFN,ON,$D(PSIVCT),$G(PSIV1),$G(PSIV2),$G(PSIVNOL))
"RTN","PSIVLABL",60,0)
;* Only if prt from ward or man list then store BCMA ID to set xref for
"RTN","PSIVLABL",61,0)
;* reprint later
"RTN","PSIVLABL",62,0)
I PSIV1,$G(PSIVWMFL) S PSIVID($P(PSJBCID,"V",2))=""
"RTN","PSIVLABL",63,0)
I PSJIO,$G(PSJIO("SL"))]"" X PSJIO("SL")
"RTN","PSIVLABL",64,0)
I PSIV1 D BARCODE
"RTN","PSIVLABL",65,0)
S X="["_$P(^PS(55,DFN,"IV",+ON,0),U)_"]"_" "_VADM(2)_" "_PSIVWD_" "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
"RTN","PSIVLABL",66,0)
I ($G(PSIVCLIN)>0),$L($G(PSIVRM)),'$G(VAIN(4)) N PSJTRNC S PSJTRNC=$L(X)-+$G(PSIVRM) I PSJTRNC>0,($L(PSIVWD)>PSJTRNC) D
"RTN","PSIVLABL",67,0)
. S X="["_$P(^PS(55,DFN,"IV",+ON,0),U)_"]"_" "_VADM(2)_" "_$E(PSIVWD,1,$L(PSIVWD)-PSJTRNC)_" "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
"RTN","PSIVLABL",68,0)
D P
"RTN","PSIVLABL",69,0)
S X=VADM(1) S:$P(PSIVSITE,U,9) X=X_" "_$S(VAIN(5)]"":VAIN(5),1:"NF") D P S X=" " D P
"RTN","PSIVLABL",70,0)
I $D(PSIVFLAG) F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",+ON,"AD",PSIV)) Q:'PSIV S Y=^(PSIV,0),X=$S($D(^PS(52.6,+Y,0)):$P(^(0),"^"),1:"*********")_" "_$P(Y,U,2)_" " S:$P(Y,U,3)]"" X=X_" ("_$P(Y,U,3)_")" D
"RTN","PSIVLABL",71,0)
. D P
"RTN","PSIVLABL",72,0)
. ;I PSIV1 S YY=Y D UP2^PSIVBCID(DFN,PSJBLN,PSIV,YY) S Y=YY
"RTN","PSIVLABL",73,0)
. D MESS
"RTN","PSIVLABL",74,0)
G:$D(PSIVFLAG) SOL
"RTN","PSIVLABL",75,0)
; IV BOTTLE functionality, 3rd piece of PS(55,DFN,"IV",+ON,"AD",PSIV,0) dictates labels per LABEL RUN on which the additive will print
"RTN","PSIVLABL",76,0)
F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",+ON,"AD",PSIV)) Q:'PSIV S Y=^(PSIV,0),X=$S($D(^PS(52.6,+Y,0)):$P(^(0),U),1:"********")_" "_$P(Y,U,2) I ","_$P(Y,U,3)_","[(","_P(16)_",")!('$P(Y,U,3)) D
"RTN","PSIVLABL",77,0)
. D P
"RTN","PSIVLABL",78,0)
. I PSIV1 S YY=Y D UP2^PSIVBCID(DFN,PSJBLN,PSIV,YY) S Y=YY
"RTN","PSIVLABL",79,0)
. D MESS
"RTN","PSIVLABL",80,0)
;
"RTN","PSIVLABL",81,0)
SOL F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",+ON,"SOL",PSIV)) Q:'PSIV S PSIV=PSIV_"^"_+^(PSIV,0),YY=^(0) D
"RTN","PSIVLABL",82,0)
. D SOL1,P I PSIV1 D UP3^PSIVBCID(DFN,PSJBLN,PSIV,YY)
"RTN","PSIVLABL",83,0)
. S X=$P(^PS(52.7,$P(PSIV,U,2),0),U,4) I X]"" S X=" "_X D P
"RTN","PSIVLABL",84,0)
I P(23)'=""!(P(4)="S") S X="In Syringe: "_$E($P(^PS(55,DFN,"IV",+ON,2),U,4),1,25) D:P(4)="S"!(P(23)="S") P S X="*CAUTION* - CHEMOTHERAPY" D:P(23)'="" P
"RTN","PSIVLABL",85,0)
S X=" " D P I PSIV1'>0!'$P(PSIVSITE,U,3)!($P(PSIVSITE,U,3)=1&(P(4)'="P"))!($P(PSIVSITE,U,3)=2&("AH"'[P(4))) G MEDRT
"RTN","PSIVLABL",86,0)
S:'$D(PSIVDOSE) PSIVDOSE="" S X=$P(PSIVDOSE," ",PSIV1) D:$E(X)="." CONVER S X="Dose due at: "_$S(X="":"________",1:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_" "_$E(X#1_"000",2,5)) D P
"RTN","PSIVLABL",87,0)
;
"RTN","PSIVLABL",88,0)
MEDRT ;Find Medication Route
"RTN","PSIVLABL",89,0)
S PSIVRP="",PSIVRT=""
"RTN","PSIVLABL",90,0)
I $D(^PS(55,DFN,"IV",+ON,.2)) S PSIVRP=$P(^PS(55,DFN,"IV",+ON,.2),U,3) D
"RTN","PSIVLABL",91,0)
.S PSIVRT=$P(^PS(51.2,PSIVRP,0),U,1)
"RTN","PSIVLABL",92,0)
.S X="ROUTE: "_PSIVRT D:X]"" PMR
"RTN","PSIVLABL",93,0)
;
"RTN","PSIVLABL",94,0)
INF S X=$P(P(8),"@") D:X]"" P
"RTN","PSIVLABL",95,0)
I $D(^PS(55,DFN,"IV",+ON,3)) S X=$P(^(3),"^") D:X]"" P
"RTN","PSIVLABL",96,0)
S X=P(9) D:X]"" P
"RTN","PSIVLABL",97,0)
S X=P(11) D:X]"" P
"RTN","PSIVLABL",98,0)
;PSJ*5*184 - Display all messages if more than one additive has a message.
"RTN","PSIVLABL",99,0)
I $D(MESS) S PSIMESS="" F S PSIMESS=$O(MESS(PSIMESS)) Q:PSIMESS="" S X=PSIMESS D P
"RTN","PSIVLABL",100,0)
I $D(^PS(59.5,PSIVSN,4)) S Y=^(4) F PSIV=1:1 S X=$P(Y,U,PSIV) Q:X="" D P
"RTN","PSIVLABL",101,0)
S X=PSIV1_"["_$S(PSIV1:PSIVNOL,1:PSIV2)_"]"_" "_$S('PSIV1:PSIVNOW,1:"") D P
"RTN","PSIVLABL",102,0)
Q
"RTN","PSIVLABL",103,0)
;
"RTN","PSIVLABL",104,0)
P F LINE=LINE+1:1 D Q:$L(X)<1
"RTN","PSIVLABL",105,0)
. I LINE>PSIVSITE D
"RTN","PSIVLABL",106,0)
.. S LINE=1
"RTN","PSIVLABL",107,0)
.. I 'PSJIO D Q
"RTN","PSIVLABL",108,0)
... F ZZ=1:1 Q:ZZ>$P(PSIVSITE,"^",16) W !
"RTN","PSIVLABL",109,0)
.. F I="EL","SL" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABL",110,0)
. K ZZ
"RTN","PSIVLABL",111,0)
. F I="ST","STF" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABL",112,0)
. W $E(X,1,PSIVRM)
"RTN","PSIVLABL",113,0)
. F I="ETF","ET" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABL",114,0)
. I 'PSJIO W !
"RTN","PSIVLABL",115,0)
. S X=$E(X,PSIVRM+1,999)
"RTN","PSIVLABL",116,0)
Q
"RTN","PSIVLABL",117,0)
PMR ; Print Med Route on label
"RTN","PSIVLABL",118,0)
;
"RTN","PSIVLABL",119,0)
F LINE=LINE+1:1 D Q:$L(X)<1
"RTN","PSIVLABL",120,0)
. I LINE>PSIVSITE D
"RTN","PSIVLABL",121,0)
.. S LINE=1
"RTN","PSIVLABL",122,0)
.. I 'PSJIO D Q
"RTN","PSIVLABL",123,0)
... F ZZ=1:1 Q:ZZ>$P(PSIVSITE,"^",16) W !
"RTN","PSIVLABL",124,0)
.. F I="EL","SL" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABL",125,0)
. K ZZ
"RTN","PSIVLABL",126,0)
. ;
"RTN","PSIVLABL",127,0)
. F I="ST","STF","SM","SMF" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABL",128,0)
. W $E(X,1,PSIVRM)
"RTN","PSIVLABL",129,0)
. F I="ETF","ET","EMF","EM" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABL",130,0)
. I 'PSJIO W !
"RTN","PSIVLABL",131,0)
. S X=$E(X,PSIVRM+1,999)
"RTN","PSIVLABL",132,0)
Q
"RTN","PSIVLABL",133,0)
;
"RTN","PSIVLABL",134,0)
SOL1 S X=$S($D(^PS(52.7,$P(PSIV,U,2),0)):$P(^(0),"^")_" "_$P(^PS(55,DFN,"IV",+ON,"SOL",+PSIV,0),U,2),1:"**********") Q
"RTN","PSIVLABL",135,0)
MESS ;PSJ*5*184 -make MESS a local array so all messages display for all additives.
"RTN","PSIVLABL",136,0)
I $P(^PS(52.6,+Y,0),U,9)]"" S MESS($P(^PS(52.6,+Y,0),U,9))=""
"RTN","PSIVLABL",137,0)
Q
"RTN","PSIVLABL",138,0)
CONVER ;Expand dose to date.dose and set in X
"RTN","PSIVLABL",139,0)
I P(15)>1440 S X=$$CONVER1^PSIVORE2($P(PSIVDOSE," "),P(15),(PSIV1-1)) Q
"RTN","PSIVLABL",140,0)
S PDOSE=X S:PSIV1=2 PDATE=$E($P(PSIVDOSE," "),1,7)
"RTN","PSIVLABL",141,0)
I $P(PSIVDOSE," ",PSIV1-1)#1'1440) S:$D(X1) XX1=X1 S:$D(X2) XX2=X2 S X1=PDATE,X2=1 D C^%DTC S PDATE=X,X=X_PDOSE S:$D(XX1) X1=XX1 S:$D(XX2) X2=XX2 Q
"RTN","PSIVLABL",142,0)
S X=PDATE_PDOSE
"RTN","PSIVLABL",143,0)
Q
"RTN","PSIVLABL",144,0)
BARCODE D PSET^%ZISP
"RTN","PSIVLABL",145,0)
I 'PSJIO D
"RTN","PSIVLABL",146,0)
. I IOBARON]"" W @IOBARON
"RTN","PSIVLABL",147,0)
. W PSJBCID
"RTN","PSIVLABL",148,0)
. I IOBAROFF]"" W @IOBAROFF
"RTN","PSIVLABL",149,0)
. W !
"RTN","PSIVLABL",150,0)
I PSJIO D
"RTN","PSIVLABL",151,0)
. F I="SB","SBF" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABL",152,0)
. W PSJBCID
"RTN","PSIVLABL",153,0)
. F I="EBF","EB" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABL",154,0)
Q
"RTN","PSIVLABR")
0^6^B40125605^B39932964
"RTN","PSIVLABR",1,0)
PSIVLABR ;BIR/PR-REPRINT LABELS ;30 May 2001 12:36 PM
"RTN","PSIVLABR",2,0)
;;5.0;INPATIENT MEDICATIONS;**58,82,178,184,279,331**;16 DEC 97;Build 15
"RTN","PSIVLABR",3,0)
;
"RTN","PSIVLABR",4,0)
; Reference to ^%ZIS(2 is supported by DBIA 3435.
"RTN","PSIVLABR",5,0)
; Reference to ^PS(52.6 is supported by DBIA 1231.
"RTN","PSIVLABR",6,0)
; Reference to ^PS(52.7 is supported by DBIA 2173.
"RTN","PSIVLABR",7,0)
; Reference to ^PS(55 is supported by DBIA 2191.
"RTN","PSIVLABR",8,0)
; Reference to ^PS(51.2 is supported by DBIA 2178.
"RTN","PSIVLABR",9,0)
;
"RTN","PSIVLABR",10,0)
;Needs DFN,ON, and PSIVNOL NOTE: If PSIVCT is defined then we do
"RTN","PSIVLABR",11,0)
;not count labels in the STATs file or increment cummulative doses or
"RTN","PSIVLABR",12,0)
;the last fill field.
"RTN","PSIVLABR",13,0)
;PSIVCT will be defined if reprinting scheduled labels, the suspense
"RTN","PSIVLABR",14,0)
;list, or if printing individual labels and they do not count.
"RTN","PSIVLABR",15,0)
;
"RTN","PSIVLABR",16,0)
DEM ;Get demographics and see if label is example only
"RTN","PSIVLABR",17,0)
N X0,PSJIO,I,PSIVCLAB
"RTN","PSIVLABR",18,0)
S I=0 F S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I S X0=$G(^(I,0)) I X0]"" S PSJIO($P(X0,"^"))=^(1)
"RTN","PSIVLABR",19,0)
S PSJIO=$S('$D(PSJIO):0,1:1)
"RTN","PSIVLABR",20,0)
N PSIVCLIN,PSIVCLDT S PSIVCLIN=$G(^PS(55,DFN,"IV",+ON,"DSS")) S:'(PSIVCLIN>0) PSIVCLIN="" I PSIVCLIN D
"RTN","PSIVLABR",21,0)
.S PSIVCLDT=$P(PSIVCLIN,"^",2) S $P(PSIVCLIN,"^",2)=$P($G(^SC(+PSIVCLIN,0)),"^")
"RTN","PSIVLABR",22,0)
I $G(PSIVCLIN) S PSIVCLAB=$P($G(^SC(+PSIVCLIN,0)),"^",2)
"RTN","PSIVLABR",23,0)
D ENIV^PSJAC,NOW^%DTC S PSIVNOW=$$ENDTC^PSGMI(%),VADM(2)=$E(VADM(2),6,9)
"RTN","PSIVLABR",24,0)
S PSIVWD=$S((+VAIN(4)&'$G(PSIVCLDT)):$P(VAIN(4),U,2),$G(PSIVCLIN)&($G(PSIVCLAB)]""):PSIVCLAB,$G(PSIVCLIN)&($P($G(PSIVCLIN),"^",2)]""):$P(PSIVCLIN,"^",2),1:"Opt. IV") I $D(PSIVEXAM) G ENX
"RTN","PSIVLABR",25,0)
;
"RTN","PSIVLABR",26,0)
;;NEW PSIVNOL,PSIV1 S (PSIVNOL,PSIV1)=1
"RTN","PSIVLABR",27,0)
NEW PSIV1 S PSIV1=1
"RTN","PSIVLABR",28,0)
G:PSIVNOL<1 Q D SETP S PSIVRM=$P(PSIVSITE,U,13),P16=$P($G(^PS(55,DFN,"IV",+ON,9)),U,3) S:PSIVRM<1 PSIVRM=30 I $D(PSIVCT),PSIVCT'=1 K PSIVCT
"RTN","PSIVLABR",29,0)
I PSJIO,$G(PSJIO("FI"))]"" X PSJIO("FI")
"RTN","PSIVLABR",30,0)
;PSJRPHD is defined in REPRT^PSIVLBRP so header only print once.
"RTN","PSIVLABR",31,0)
I $P(PSIVSITE,U,7),'$D(PSJRPHD) D
"RTN","PSIVLABR",32,0)
. S PSIVFLAG=1,(LINE,PSIV1)=0,PSIV2=PSIVNOL,PSIVNOL=0 D RE
"RTN","PSIVLABR",33,0)
. S PSIVRP="",PSIVRT=""
"RTN","PSIVLABR",34,0)
. I $D(^PS(55,DFN,"IV",+ON,.2)) S PSIVRP=$P(^PS(55,DFN,"IV",+ON,.2),U,3) D
"RTN","PSIVLABR",35,0)
.. I PSIV1'>0!'$P(PSIVSITE,U,3)!($P(PSIVSITE,U,3)=1&(P(4)'="P"))!($P(PSIVSITE,U,3)=2&("AH"'[P(4))) Q ;QUIT IF "DOSE DUE AT" IS SET TO NOT PRINT
"RTN","PSIVLABR",36,0)
.. S PSIVRT=$P(^PS(51.2,PSIVRP,0),U,1)
"RTN","PSIVLABR",37,0)
.. S X="ROUTE: "_PSIVRT D:X]"" PMR
"RTN","PSIVLABR",38,0)
. S X="Solution: _______________" D P S X="Additive: _______________" D P
"RTN","PSIVLABR",39,0)
. S PSIVNOL=PSIV2
"RTN","PSIVLABR",40,0)
. I 'PSJIO F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
"RTN","PSIVLABR",41,0)
. I PSJIO,$G(PSJIO("EL"))]"" X PSJIO("EL")
"RTN","PSIVLABR",42,0)
;;I '$D(PSIVCT) D NOW^%DTC S Y=%,$P(^PS(55,DFN,"IV",+ON,9),U,1,2)=Y_"^"_PSIVNOL,$P(^(9),U,3)=$P(^(9),U,3)+PSIVNOL
"RTN","PSIVLABR",43,0)
I '$D(PSIVCT) D NOW^%DTC S Y=%,$P(^PS(55,DFN,"IV",+ON,9),U,1,2)=Y_"^"_PSIVNOL,$P(^(9),U,3)=$P(^(9),U,3)+1
"RTN","PSIVLABR",44,0)
K PSIVFLAG,PSIVSH G START
"RTN","PSIVLABR",45,0)
SETP S Y=^PS(55,DFN,"IV",+ON,0) F X=1:1:23 S P(X)=$P(Y,U,X)
"RTN","PSIVLABR",46,0)
Q
"RTN","PSIVLABR",47,0)
ENX ;Print example label
"RTN","PSIVLABR",48,0)
D SETP S PSIVFLAG=1,PSIVRM=$P(PSIVSITE,U,13) S:PSIVRM<1 PSIVRM=30
"RTN","PSIVLABR",49,0)
START S PSIV1=1,LINE=0 D RE D
"RTN","PSIVLABR",50,0)
. Q:$D(PSIVFLAG)
"RTN","PSIVLABR",51,0)
. I 'PSJIO F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
"RTN","PSIVLABR",52,0)
. I PSJIO,$G(PSJIO("EL"))]"" X PSJIO("EL")
"RTN","PSIVLABR",53,0)
I PSJIO,$G(PSJIO("FE"))]"" X PSJIO("FE")
"RTN","PSIVLABR",54,0)
D:'$D(PSIVCT) ^PSIVSTAT
"RTN","PSIVLABR",55,0)
Q K PSIV,PSIVDOSE,PSIVCT,PSIVWD,P16,LINE,MESS,PSIV2,PSIVFLAG,PSIVRM,PSIV1,PDOSE,PDATE,XX1,XX2,BAG,CX,PSIMESS Q
"RTN","PSIVLABR",56,0)
RE ;
"RTN","PSIVLABR",57,0)
;NEED THE CODE BELOW?
"RTN","PSIVLABR",58,0)
;;I PSIV1,P(4)="A"!(P(5)=0) S:P(15)>2880!('P(15)) P(15)=2880 S P(16)=P16+PSIV1#(1440/P(15)+.5\1) S:'P(16) P(16)=PSIV1
"RTN","PSIVLABR",59,0)
I PSJIO,$G(PSJIO("SL"))]"" X PSJIO("SL")
"RTN","PSIVLABR",60,0)
I PSIV1 D BARCODE
"RTN","PSIVLABR",61,0)
S X="["_$P(^PS(55,DFN,"IV",+ON,0),U)_"]"_" "_VADM(2)_" "_PSIVWD_" "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
"RTN","PSIVLABR",62,0)
I ($G(PSIVCLIN)>0),$L($G(PSIVRM)),'$G(VAIN(4)) N PSJTRNC S PSJTRNC=$L(X)-+$G(PSIVRM) I PSJTRNC>0,($L(PSIVWD)>PSJTRNC) D
"RTN","PSIVLABR",63,0)
. S X="["_$P(^PS(55,DFN,"IV",+ON,0),U)_"]"_" "_VADM(2)_" "_$E(PSIVWD,1,$L(PSIVWD)-PSJTRNC)_" "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
"RTN","PSIVLABR",64,0)
D P
"RTN","PSIVLABR",65,0)
;D
"RTN","PSIVLABR",66,0)
;.N PSJICW,TMPX,TMPX1,TMPX2 S TMPX=X,TMPX1="" I $L(TMPX)>(PSIVRM-1) F PSJICW=1:1:$L(TMPX," ") S TMPX1=TMPX1_$S(PSJICW=1:"",1:" ")_$P(TMPX," ",PSJICW) I $L(TMPX1)+$L($P(TMPX," ",PSJICW+1))>(PSIVRM-1) S X=TMPX1 D P S TMPX1="",X=""
"RTN","PSIVLABR",67,0)
;.I TMPX1]"" S X=TMPX1 D P
"RTN","PSIVLABR",68,0)
S X=VADM(1) S:$P(PSIVSITE,U,9) X=X_" "_$S(VAIN(5)]"":VAIN(5),1:"NF") D P S X=" " D P
"RTN","PSIVLABR",69,0)
I $D(PSIVFLAG) F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",+ON,"AD",PSIV)) Q:'PSIV S Y=^(PSIV,0),X=$S($D(^PS(52.6,+Y,0)):$P(^(0),"^"),1:"*********")_" "_$P(Y,U,2)_" " S:$P(Y,U,3)]"" X=X_" ("_$P(Y,U,3)_")" D
"RTN","PSIVLABR",70,0)
. D P,MESS
"RTN","PSIVLABR",71,0)
G:$D(PSIVFLAG) SOL
"RTN","PSIVLABR",72,0)
F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IVBCMA",PSJIDNO,"AD",PSIV)) Q:'PSIV S Y=^(PSIV,0),X=$S($D(^PS(52.6,+Y,0)):$P(^(0),U),1:"********")_" "_$P(Y,U,2) D
"RTN","PSIVLABR",73,0)
. D P,MESS
"RTN","PSIVLABR",74,0)
SOL F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",PSIV)) Q:'PSIV S PSIV=PSIV_"^"_+^(PSIV,0),YY=^(0) D
"RTN","PSIVLABR",75,0)
. D SOL1,P
"RTN","PSIVLABR",76,0)
. S X=$P(^PS(52.7,$P(PSIV,U,2),0),U,4) I X]"" S X=" "_X D P
"RTN","PSIVLABR",77,0)
I P(23)'=""!(P(4)="S") S X="In Syringe: "_$E($P(^PS(55,DFN,"IV",+ON,2),U,4),1,25) D:P(4)="S"!(P(23)="S") P S X="*CAUTION* - CHEMOTHERAPY" D:P(23)'="" P
"RTN","PSIVLABR",78,0)
S X=" " D P I PSIV1'>0!'$P(PSIVSITE,U,3)!($P(PSIVSITE,U,3)=1&(P(4)'="P"))!($P(PSIVSITE,U,3)=2&("AH"'[P(4))) G MEDRT
"RTN","PSIVLABR",79,0)
S:'$D(PSIVDOSE) PSIVDOSE="" S X=$P(PSIVDOSE," ",PSIV1) D:$E(X)="." CONVER S X="Dose due at: "_$S(X="":"________",1:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_" "_$E(X#1_"000",2,5)) D P
"RTN","PSIVLABR",80,0)
;
"RTN","PSIVLABR",81,0)
MEDRT ;Find Medication Route
"RTN","PSIVLABR",82,0)
S PSIVRP="",PSIVRT=""
"RTN","PSIVLABR",83,0)
I $D(^PS(55,DFN,"IV",+ON,.2)) S PSIVRP=$P(^PS(55,DFN,"IV",+ON,.2),U,3) D
"RTN","PSIVLABR",84,0)
.S PSIVRT=$P(^PS(51.2,PSIVRP,0),U,1)
"RTN","PSIVLABR",85,0)
.S X="ROUTE: "_PSIVRT D:X]"" PMR
"RTN","PSIVLABR",86,0)
;
"RTN","PSIVLABR",87,0)
INF S X=$P(P(8),"@") D:X]"" P
"RTN","PSIVLABR",88,0)
I $D(^PS(55,DFN,"IV",+ON,3)) S X=$P(^(3),"^") D:X]"" P
"RTN","PSIVLABR",89,0)
S X=P(9) D:X]"" P
"RTN","PSIVLABR",90,0)
S X=P(11) D:X]"" P
"RTN","PSIVLABR",91,0)
;PSJ*5*184 - Display all messages if more than one additive has a message.
"RTN","PSIVLABR",92,0)
I $D(MESS) S PSIMESS="" F S PSIMESS=$O(MESS(PSIMESS)) Q:PSIMESS="" S X=PSIMESS D P
"RTN","PSIVLABR",93,0)
I $D(^PS(59.5,PSIVSN,4)) S Y=^(4) F PSIV=1:1 S X=$P(Y,U,PSIV) Q:X="" D P
"RTN","PSIVLABR",94,0)
;S X=PSIV1_"["_$S(PSIV1:PSIVNOL,1:PSIV2)_"]"_" "_$S('PSIV1:PSIVNOW,1:"") D P
"RTN","PSIVLABR",95,0)
S X=PSIVBAG D P
"RTN","PSIVLABR",96,0)
Q
"RTN","PSIVLABR",97,0)
P F LINE=LINE+1:1 D Q:$L(X)<1
"RTN","PSIVLABR",98,0)
. I LINE>PSIVSITE D
"RTN","PSIVLABR",99,0)
.. S LINE=1
"RTN","PSIVLABR",100,0)
.. I 'PSJIO D Q
"RTN","PSIVLABR",101,0)
... F ZZ=1:1 Q:ZZ>$P(PSIVSITE,"^",16) W !
"RTN","PSIVLABR",102,0)
.. F I="EL","SL" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABR",103,0)
. K ZZ
"RTN","PSIVLABR",104,0)
. F I="ST","STF" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABR",105,0)
. W $E(X,1,PSIVRM)
"RTN","PSIVLABR",106,0)
. F I="ETF","ET" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABR",107,0)
. I 'PSJIO W !
"RTN","PSIVLABR",108,0)
. S X=$E(X,PSIVRM+1,999)
"RTN","PSIVLABR",109,0)
Q
"RTN","PSIVLABR",110,0)
PMR ; Print Med Route on label
"RTN","PSIVLABR",111,0)
;
"RTN","PSIVLABR",112,0)
F LINE=LINE+1:1 D Q:$L(X)<1
"RTN","PSIVLABR",113,0)
. I LINE>PSIVSITE D
"RTN","PSIVLABR",114,0)
.. S LINE=1
"RTN","PSIVLABR",115,0)
.. I 'PSJIO D Q
"RTN","PSIVLABR",116,0)
... F ZZ=1:1 Q:ZZ>$P(PSIVSITE,"^",16) W !
"RTN","PSIVLABR",117,0)
.. F I="EL","SL" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABR",118,0)
. K ZZ
"RTN","PSIVLABR",119,0)
. ;
"RTN","PSIVLABR",120,0)
. F I="ST","STF","SM","SMF" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABR",121,0)
. W $E(X,1,PSIVRM)
"RTN","PSIVLABR",122,0)
. F I="ETF","ET","EMF","EM" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABR",123,0)
. I 'PSJIO W !
"RTN","PSIVLABR",124,0)
. S X=$E(X,PSIVRM+1,999)
"RTN","PSIVLABR",125,0)
Q
"RTN","PSIVLABR",126,0)
SOL1 S X=$S($D(^PS(52.7,$P(PSIV,U,2),0)):$P(^(0),"^")_" "_$P(^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",+PSIV,0),U,2),1:"**********") Q
"RTN","PSIVLABR",127,0)
MESS ;PSJ*5*184 -make MESS a local array so all messages display for all additives.
"RTN","PSIVLABR",128,0)
I $P(^PS(52.6,+Y,0),U,9)]"" S MESS($P(^PS(52.6,+Y,0),U,9))=""
"RTN","PSIVLABR",129,0)
Q
"RTN","PSIVLABR",130,0)
CONVER ;Expand dose to date.dose and set in X
"RTN","PSIVLABR",131,0)
I P(15)>1440 S X=$$CONVER1^PSIVORE2($P(PSIVDOSE," "),P(15),(PSIV1-1)) Q
"RTN","PSIVLABR",132,0)
S PDOSE=X S:PSIV1=2 PDATE=$E($P(PSIVDOSE," "),1,7)
"RTN","PSIVLABR",133,0)
I $P(PSIVDOSE," ",PSIV1-1)#1'1440) S:$D(X1) XX1=X1 S:$D(X2) XX2=X2 S X1=PDATE,X2=1 D C^%DTC S PDATE=X,X=X_PDOSE S:$D(XX1) X1=XX1 S:$D(XX2) X2=XX2 Q
"RTN","PSIVLABR",134,0)
S X=PDATE_PDOSE
"RTN","PSIVLABR",135,0)
Q
"RTN","PSIVLABR",136,0)
BARCODE D PSET^%ZISP
"RTN","PSIVLABR",137,0)
I 'PSJIO D
"RTN","PSIVLABR",138,0)
. I IOBARON]"" W @IOBARON
"RTN","PSIVLABR",139,0)
. W PSJBCID
"RTN","PSIVLABR",140,0)
. I IOBAROFF]"" W @IOBAROFF
"RTN","PSIVLABR",141,0)
. W !
"RTN","PSIVLABR",142,0)
I PSJIO D
"RTN","PSIVLABR",143,0)
. F I="SB","SBF" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABR",144,0)
. W PSJBCID
"RTN","PSIVLABR",145,0)
. F I="EBF","EB" I $G(PSJIO(I))]"" X PSJIO(I)
"RTN","PSIVLABR",146,0)
Q
"RTN","PSIVSP")
0^2^B42970489^B42459538
"RTN","PSIVSP",1,0)
PSIVSP ;BIR/RGY,PR,CML3 - DOSE PROCESSOR ;1/3/12 3:36pm
"RTN","PSIVSP",2,0)
;;5.0;INPATIENT MEDICATIONS;**30,37,41,50,56,74,83,111,133,138,134,213,229,279,305,331**;16 DEC 97;Build 15
"RTN","PSIVSP",3,0)
;
"RTN","PSIVSP",4,0)
; Reference to ^PS(51.1 is supported by DBIA #2177
"RTN","PSIVSP",5,0)
;
"RTN","PSIVSP",6,0)
EN ;
"RTN","PSIVSP",7,0)
Q:'$D(X)
"RTN","PSIVSP",8,0)
S ATZERO=0 I X["@",$P(X,"@",2)=0 S ATZERO=1,X=$P(X,"@")
"RTN","PSIVSP",9,0)
D EN^PSGS0 S (P(9),PSIVSC1)=$S($G(X)]"":X,1:$G(P(9))),P(11)=$S($G(PSGS0Y):PSGS0Y,1:$G(P(11))),(XT,P(15))=$S(($G(PSGS0XT)!($G(PSGS0XT)="O")!($G(PSGS0XT)="D")):$G(PSGS0XT),1:$G(P(15)))
"RTN","PSIVSP",10,0)
I $G(ATZERO) S P(7)=1
"RTN","PSIVSP",11,0)
K ATZERO Q
"RTN","PSIVSP",12,0)
EN1 ;
"RTN","PSIVSP",13,0)
S (PSIVAT,PSIVWAT,Y)="",XT=-1,X0=X,X=$S(X="ON CALL":X,X="ONCALL":X,X="ON-CALL":X,X="ONETIME":X,X="ONE-TIME":X,X="ONE TIME":X,X="1TIME":X,X="1 TIME":X,X="1-TIME":X,$L(X," ")<3:$P(X," "),1:$P(X," ",1,2))
"RTN","PSIVSP",14,0)
S:$E(X)="^" X=$E(X,2,999) G:X="" Q S:(X["@0")&($$SCHREQ^PSJLIVFD(.P)) ATZERO=1 S X=$S(X["@0":$P(X,"@"),1:X),P(7)=$S($G(ATZERO):1,1:"") K ATZERO
"RTN","PSIVSP",15,0)
I $S($D(^PS(51.1,"AC","PSJ",X)):1,1:$E($O(^(X)),1,$L(X))=X) D DIC I Y'<0 G SH
"RTN","PSIVSP",16,0)
NS0 S Y=""
"RTN","PSIVSP",17,0)
I $E(X,1,2)="AD" S XT=-1 Q
"RTN","PSIVSP",18,0)
I $E(X,1,3)="BID"!($E(X,1,3)="TID")!($E(X,1,3)="QID") S XT=1440\$F("BTQ",$E(X))
"RTN","PSIVSP",19,0)
E S:$E(X)="Q" X=$E(X,2,99) S:'X X=$E(X)["O"+1_X S I=+X,X=$P(X,I,2),XT=I*$S(X["'":1,(X["D"&(X'["AD"))!(X["AM")!(X["PM")!(X["HS"&(X'["THS")):1440,X["H"&(X'["TH"):60,X["AC"!(X["PC"):480,X["W":10080,X["M":40320,1:0),X=X0 D
"RTN","PSIVSP",20,0)
. I 'XT,X'="NOW",X'="STAT",X'="ONCE",X'="ONE-TIME",X'="ONE TIME",X'="ONETIME",X'="1-TIME",X'="1 TIME",X'="1TIME",Y="" S XT=-1
"RTN","PSIVSP",21,0)
SH ;
"RTN","PSIVSP",22,0)
I +Y<1,$E(X0)'="^" W:$G(ON)'["P" " ",$S(XT=0&($S("^NOW^STAT^ONCE^ONE-TIME^ONETIME^1TIME^1-TIME^"[(U_$P(X," ")_U):1,X["1 TIME":1,1:X["ONE TIME")):"(ONCE ONLY)",XT>0:"Nonstandard schedule",XT<0:"",1:"(??)") W:XT>0 " (",XT," MINUTES)"
"RTN","PSIVSP",23,0)
Q Q:X="ONE TIME"
"RTN","PSIVSP",24,0)
N I S X0=$P(X," ")_$S($L(X0," ")-1:" ",1:"")_$P(X0," ",2,99) K:XT<0!($L(X0)>22) X S:$D(X) X=X0 K X0 S:$G(P(7)) XT="" Q
"RTN","PSIVSP",25,0)
NEWQ ;N I S X0=$P(X," ")_$S($L(X0," ")-1:" ",1:"")_$P(X0," ",2,99) K:XT<0!($L(X0)>22) X S:$D(X) X=X0 S:P(7) X=X0 K X0 K:XT>0&('P(7)) X Q
"RTN","PSIVSP",26,0)
Q
"RTN","PSIVSP",27,0)
;
"RTN","PSIVSP",28,0)
;*229 Add Temp val for dose limit in IOE
"RTN","PSIVSP",29,0)
ENDL N PSIVLIMT W " Dose limit .... " S PSIVLIMT="a"_X,PSIVMIN=P(15)*X,PSIVSD=+P(2)
"RTN","PSIVSP",30,0)
I PSIVMIN<0 W !!," --- There is something wrong with this order !!",!," Call inpatient supervisor ....." S Y=-1 K PSIVMIN Q
"RTN","PSIVSP",31,0)
I P(15)'["D",P(4)="P"!(P(5))!(P(23)="P"),PSIVMIN=0,"^NOW^STAT^ONCE^ONE-TIME^ONE TIME^ON CALL^ONETIME^1TIME^1 TIME^1-TIME^"'[(U_P(9)_U) D DLP G QDL
"RTN","PSIVSP",32,0)
;*229 DOW Calc and dose lim should match CPRS, if it's vol limit, we leave old functionality
"RTN","PSIVSP",33,0)
I $G(P(9))]"",$G(P(11))]"" D ENSTOP^PSIVCAL S Y=X I 1 ;*229 ENSTOP^PSIVCAL returns X, we wanted Y.
"RTN","PSIVSP",34,0)
E D ENT^PSIVWL
"RTN","PSIVSP",35,0)
QDL I $D(X) S X=Y X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) S Y=X
"RTN","PSIVSP",36,0)
Q
"RTN","PSIVSP",37,0)
DLP ;
"RTN","PSIVSP",38,0)
S X=X+1,$P(PSIVSD,".",2)=$P(PSIVSD,".",2)_$E("0000",1,4-$L($P(PSIVSD,".",2))) D CHK S X2=0,Y=1 I X<2 S Y=+PSIVSD G QDLP
"RTN","PSIVSP",39,0)
I $P(PSIVSD,".",2)>$P(P(11),"-",$L(P(11),"-")) S X2=1 G OV
"RTN","PSIVSP",40,0)
G:$P(P(11),"-")>$P(PSIVSD,".",2) OV
"RTN","PSIVSP",41,0)
F Y=1:1 S X1=$P(P(11),"-",Y) I X1=$P(PSIVSD,".",2)!($P(PSIVSD,".",2)0 S X1=PSIVSD D C^%DTC S X=$P(X,".") ; install with version 17.3 of fileman
"RTN","PSIVSP",45,0)
S Y=+(X_"."_$P(P(11),"-",Y))
"RTN","PSIVSP",46,0)
QDLP K X1,X2 Q
"RTN","PSIVSP",47,0)
;
"RTN","PSIVSP",48,0)
ENI ;
"RTN","PSIVSP",49,0)
N PSIZEROX S PSIZEROX=0_+X
"RTN","PSIVSP",50,0)
K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X)!'$D(P(4)) Q
"RTN","PSIVSP",51,0)
;*229 Reset ATZERO flag.
"RTN","PSIVSP",52,0)
I $P(X,"@",2)'=0!'$$SCHREQ^PSJLIVFD(.P) S P(7)=""
"RTN","PSIVSP",53,0)
I P(4)="P"!(P(5))!(P(23)="P") Q:'X S X="INFUSE OVER "_X_" MINUTE"_$S(X>1:"S",1:"") W " ",X Q
"RTN","PSIVSP",54,0)
I $E(X)="." K X Q ;Enforce leading zero.
"RTN","PSIVSP",55,0)
I X'=+X!(X'=0_+X),X["@",($P(X,"@",2,999)'=+$P(X,"@",2,999)!(+$P(X,"@",2,999)<0)) K X Q
"RTN","PSIVSP",56,0)
S SPSOL=$O(DRG("SOL",0)) I 'SPSOL K SPSOL,X W " You must define at least one solution !!" Q
"RTN","PSIVSP",57,0)
I (X=+X)!(X=PSIZEROX) I X'["@" S X=X_" ml/hr" W " ml/hr" D SPSOL S P(15)=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q
"RTN","PSIVSP",58,0)
S SPSOL=$S(($P(X,"@",2)?1.N):$P(X,"@",2),1:$G(P("NUMLBL"))) I SPSOL S P("NUMLBL")=+SPSOL
"RTN","PSIVSP",59,0)
S:$P(X,"@")=+X!($P(X,"@")=PSIZEROX) $P(X,"@")=$P(X,"@")_" ml/hr" W " ",+SPSOL," Label",$S(SPSOL'=1:"s",1:"")," per day",!?15,"at an infusion rate of: ",$P(X,"@") S P(15)=$S('SPSOL:0,1:1440/SPSOL\1) K SPSOL
"RTN","PSIVSP",60,0)
I X["@",$P(X,"@",2)=0,$$SCHREQ^PSJLIVFD(.P) S P(7)=1 ; Set ATZERO flag
"RTN","PSIVSP",61,0)
;*305
"RTN","PSIVSP",62,0)
I '$G(PSJEXMSG) D EXPINF^PSIVEDT1(.X)
"RTN","PSIVSP",63,0)
Q
"RTN","PSIVSP",64,0)
SPSOL S SPSOL=0 F XXX=0:0 S XXX=$O(DRG("SOL",XXX)) Q:'XXX S SPSOL=SPSOL+$P(DRG("SOL",XXX),U,3)
"RTN","PSIVSP",65,0)
K XXX Q
"RTN","PSIVSP",66,0)
CHK F Y=1:1 Q:$L(P(11))>240!($P(P(11),"-",Y)="") S $P(P(11),"-",Y)=$P(P(11),"-",Y)_$E("0000",1,4-$L($P(P(11),"-",Y)))
"RTN","PSIVSP",67,0)
Q
"RTN","PSIVSP",68,0)
;
"RTN","PSIVSP",69,0)
DIC ; 51.1 look-up
"RTN","PSIVSP",70,0)
N PSJSCH S PSJSCH=X I '$D(WSCHADM) N VAIP D IN5^VADPT S WSCHADM=VAIP(5),X=PSJSCH
"RTN","PSIVSP",71,0)
K DIC S DIC="^PS(51.1,",DIC(0)=$E("E",'$D(NOECH))_"ISZ"
"RTN","PSIVSP",72,0)
S DIC("W")="W "" "","_$S('$D(WSCHADM):"$P(^(0),""^"",2)",'+WSCHADM:"$P(^(0),""^"",2)",1:"$S($D(^PS(51.1,+Y,1,+WSCHADM,0)):$P(^(0),""^"",2),1:$P(^PS(51.1,+Y,0),""^"",2))"),D="APPSJ" S:$D(PSIVSPQF) DIC(0)=DIC(0)_"O"
"RTN","PSIVSP",73,0)
D IX^DIC K DIC
"RTN","PSIVSP",74,0)
S:$D(DIE)#2 DIC=DIE Q:Y<0
"RTN","PSIVSP",75,0)
S X=Y(0,0),ZZY=Y,(XT,Y)="" I $D(WSCHADM),$D(^PS(51.1,+ZZY,1,+WSCHADM,0)),$P(^(0),"^",2)]"" S (PSIVWAT,Y)=$P(^(0),"^",2)
"RTN","PSIVSP",76,0)
K ZZY,WSCHADM S:Y="" (X,PSIVSC1)=$P(Y(0),U),(PSIVAT,Y)=$P(Y(0),"^",2) S XT=$P(Y(0),"^",3) Q
"RTN","PSIVSP",77,0)
;
"RTN","PSIVSP",78,0)
ORINF ; OERR input transform for Infusion Rate
"RTN","PSIVSP",79,0)
; X=data
"RTN","PSIVSP",80,0)
N INFUSE
"RTN","PSIVSP",81,0)
K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q
"RTN","PSIVSP",82,0)
I X?.E1L.E S INFUSE=$$ENLU^PSGMI(X) Q:(INFUSE="TITRATE")!(INFUSE="BOLUS")!($P(INFUSE," ")="INFUSE")!($P(INFUSE," ")="Infuse")
"RTN","PSIVSP",83,0)
Q:(X="TITRATE")!(X="BOLUS")!($P(X," ")="INFUSE")!($P(X," ")="Infuse")
"RTN","PSIVSP",84,0)
I X["=" D Q ; NOIS LOU-0501-42191
"RTN","PSIVSP",85,0)
.N X2,X1 S X1=$P(X,"="),X2=$P(X,"=",2)
"RTN","PSIVSP",86,0)
.I X1["ML/HR",(+X1=$P(X1,"ML/HR"))!(+X1=$P(X1," ML/HR")) D
"RTN","PSIVSP",87,0)
..S X1=$TR(X1,"ML/HR","ml/hr")
"RTN","PSIVSP",88,0)
.I X2["ML/HR",(+X2=$P(X2,"ML/HR"))!(+X2=$P(X2," ML/HR")) D
"RTN","PSIVSP",89,0)
..S X2=$TR(X2,"ML/HR","ml/hr")
"RTN","PSIVSP",90,0)
.I X1[" ml/hr",(+X1=$P(X1," ml/hr")) D
"RTN","PSIVSP",91,0)
..S X1=$P(X1," ml/hr")_$P(X1," ml/hr",2,9999)
"RTN","PSIVSP",92,0)
.I X2[" ml/hr",(+X2=$P(X2," ml/hr")) D
"RTN","PSIVSP",93,0)
..S X2=$P(X2," ml/hr")_$P(X2," ml/hr",2,9999)
"RTN","PSIVSP",94,0)
.I X1["ml/hr",(+X1=$P(X1,"ml/hr")) D
"RTN","PSIVSP",95,0)
..S X1=$P(X1,"ml/hr")_$P(X1,"ml/hr",2,9999)
"RTN","PSIVSP",96,0)
.I X2["ml/hr",(+X2=$P(X2,"ml/hr")) D
"RTN","PSIVSP",97,0)
..S X2=$P(X2,"ml/hr")_$P(X2,"ml/hr",2,9999)
"RTN","PSIVSP",98,0)
.I X2'=+X2 D
"RTN","PSIVSP",99,0)
..I X2>0&(X2<1) Q
"RTN","PSIVSP",100,0)
..I ($P(X2,"@",2,999)'=+$P(X2,"@",2,999)!(+$P(X2,"@",2,999)<0)) K X Q
"RTN","PSIVSP",101,0)
.I X1>0&(X1<1) I +X1="."_$P(X1,".",2) S X1=X1_" ml/hr"
"RTN","PSIVSP",102,0)
.I X2>0&(X2<1) I +X2="."_$P(X2,".",2) S X2=X2_" ml/hr"
"RTN","PSIVSP",103,0)
.I X1=+X1 S X1=X1_" ml/hr"
"RTN","PSIVSP",104,0)
.I X2=+X2 S X2=X2_" ml/hr"
"RTN","PSIVSP",105,0)
.S:$P(X2,"@")=+X2 $P(X2,"@")=$P(X2,"@")_" ml/hr"
"RTN","PSIVSP",106,0)
.S X=X1_"="_X2
"RTN","PSIVSP",107,0)
I X["ML/HR",(+X=$P(X,"ML/HR"))!(+X=$P(X," ML/HR")) S X=$TR(X,"ML/HR","ml/hr")
"RTN","PSIVSP",108,0)
I X[" ml/hr",+X=$P(X," ml/hr") S X=$P(X," ml/hr")_$P(X," ml/hr",2,9999)
"RTN","PSIVSP",109,0)
I X["ml/hr",+X=$P(X,"ml/hr") S X=$P(X,"ml/hr")_$P(X,"ml/hr",2,9999)
"RTN","PSIVSP",110,0)
I X>0,X<1 D Q
"RTN","PSIVSP",111,0)
.I X["ML/HR",(+X=$P($P(X,"ML/HR"),".",2))!(+X=$P($P(X," ML/HR"),".",2)) S X=$TR(X,"ML/HR","ml/hr")
"RTN","PSIVSP",112,0)
.I X[" ml/hr",(+X=$P($P(X," ml/hr"),".",2)) S X=$P(X," ml/hr")_$P(X," ml/hr",2,9999)
"RTN","PSIVSP",113,0)
.I X["ml/hr",+X=$P(X,"ml/hr") S X=$P(X,"ml/hr")_$P(X,"ml/hr",2,9999)
"RTN","PSIVSP",114,0)
.I +X=X S X=X_" ml/hr"
"RTN","PSIVSP",115,0)
.I $P(X,0,2)=+X S X=X_" ml/hr"
"RTN","PSIVSP",116,0)
.S X=0_+X_$P(X,+X,2)
"RTN","PSIVSP",117,0)
I '(X>0&X<1) I X'=+X,($P(X,"@",2,999)'=+$P(X,"@",2,999)!(+$P(X,"@",2,999)<0)) K X Q
"RTN","PSIVSP",118,0)
I X=+X S X=X_" ml/hr" Q
"RTN","PSIVSP",119,0)
S:$P(X,"@")=+X $P(X,"@")=$P(X,"@")_" ml/hr"
"RTN","PSIVSP",120,0)
Q
"RTN","PSJAC")
0^3^B18714704^B18623217
"RTN","PSJAC",1,0)
PSJAC ;BIR/CML3 - INPATIENT INFORMATION ;28 Apr 98 / 9:02 AM
"RTN","PSJAC",2,0)
;;5.0;INPATIENT MEDICATIONS;**8,10,50,127,181,275,279,331**;16 DEC 97;Build 15
"RTN","PSJAC",3,0)
;
"RTN","PSJAC",4,0)
; Reference to ^PS(55 is supported by DBIA# 2191.
"RTN","PSJAC",5,0)
;
"RTN","PSJAC",6,0)
S DFN=PSGP,PSJACPF=1 G CHK
"RTN","PSJAC",7,0)
;
"RTN","PSJAC",8,0)
ENBOTH ;
"RTN","PSJAC",9,0)
S PSJACPF=11 G CHK
"RTN","PSJAC",10,0)
;
"RTN","PSJAC",11,0)
ENIV ;
"RTN","PSJAC",12,0)
N I,J,JJ,ON,PSJRBXX,X,X1,X2,X,Y S PSJACPF=10,PSGP=DFN
"RTN","PSJAC",13,0)
;
"RTN","PSJAC",14,0)
CHK ;
"RTN","PSJAC",15,0)
;Check if 5.0 order conversion should be run for the selected patient.
"RTN","PSJAC",16,0)
;I '$P($G(^PS(55,DFN,5.1)),U,11) D CONVERT^PSJUTL1(DFN,$S($E(IOST,1)="C":1,1:0))
"RTN","PSJAC",17,0)
;/Commented out in PSJ*5*50. No longer needed
"RTN","PSJAC",18,0)
;/F S PSJRBXX=$$OTF^OR3CONV(DFN,$S($E(IOST,1)="C":0,1:1)) Q:+PSJRBXX'<0 D
"RTN","PSJAC",19,0)
;/.I +PSJRBXX=-1 W:$E(IOST,1)="C" !,$P(PSJRBXX,"^",2) H 4
"RTN","PSJAC",20,0)
;Converting IV order to new OI with POE if not done so when installed PSJ*5*50
"RTN","PSJAC",21,0)
D CNIV^PSJUTL1(DFN)
"RTN","PSJAC",22,0)
;I $D(^PS(55,DFN,0)),'$P($G(^PS(55,DFN,0)),U,6) D EN^PSOHLUP(DFN)
"RTN","PSJAC",23,0)
S VA200=1 D INP^VADPT
"RTN","PSJAC",24,0)
I VAIN(4) S:PSJACPF#2 PSJPCAF=1_"^"_VAIN(1),PSJPWD=+VAIN(4),PSJPWDN=$P(VAIN(4),"^",2),PSJPTS=+VAIN(3),PSJPTSP=+VAIN(2),PSJPRB=VAIN(5),PSJPAD=+VAIN(7),PSJPDX=VAIN(9),PSJPTD=$S($D(^PS(55,PSGP,5.1)):$P(^(5.1),"^",4),1:""),PSJPDD="" G CNV
"RTN","PSJAC",25,0)
S VAIP("D")="L" D IN5^VADPT G:PSJACPF[0 CNV
"RTN","PSJAC",26,0)
S PSJPCAF="",PSJPAD=+VAIP(13,1)
"RTN","PSJAC",27,0)
S PSGID=+VAIP(3),X=+VAIP(4)=12!(+VAIP(4)=38)!($G(VADM(6))),PSJPWD=+VAIP(5),PSJPWDN=$P(VAIP(5),"^",2),PSJPRB=$P(VAIP(6),"^",2),PSJPTSP=+VAIP(7),PSJPTS=+VAIP(8),PSJPDX=VAIP(9),PSJPTD="",PSJPDD=PSGID_"^"_$$ENDTC^PSGMI(PSGID) S:X PSJPDD=PSJPDD_"^1"
"RTN","PSJAC",28,0)
;
"RTN","PSJAC",29,0)
CNV ;
"RTN","PSJAC",30,0)
D DEM^VADPT,HTWT(PSGP)
"RTN","PSJAC",31,0)
I PSJACPF#2 S PSGP(0)=VADM(1),PSJPSSN=VADM(2),PSJPDOB=+VADM(3),PSJPAGE=VADM(4),PSJPSEX=$S(VADM(5)]"":VADM(5),1:"?^____"),PSJPPID=VA("PID"),PSJPBID=VA("BID")
"RTN","PSJAC",32,0)
I PSJACPF#2 D
"RTN","PSJAC",33,0)
.I $D(PSJY2K) D Q
"RTN","PSJAC",34,0)
..F X="PSJPAD","PSJPDOB","PSJPTD" I @X S $P(@X,"^",2)=$$ENDTC2^PSGMI(+@X)
"RTN","PSJAC",35,0)
.F X="PSJPAD","PSJPDOB","PSJPTD" I @X S $P(@X,"^",2)=$$ENDTC^PSGMI(+@X)
"RTN","PSJAC",36,0)
;
"RTN","PSJAC",37,0)
WP ; ward parameters
"RTN","PSJAC",38,0)
G:$D(PSJACNWP) DONE S PSJSYSW0="",PSJSYSW=0 I $G(PSJPWD) S PSJSYSW=+$O(^PS(59.6,"B",PSJPWD,0)) I PSJSYSW S PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
"RTN","PSJAC",39,0)
S PSJSYSL="",X=$P(PSJSYSU,";",3)>1 S PSJSYSL=$S(X=0:$P(PSJSYSW0,"^",12),1:$P(PSJSYSW0,"^",16)) G:$D(PSJACND) DONE
"RTN","PSJAC",40,0)
I PSJSYSL D
"RTN","PSJAC",41,0)
.S:X X='$P($G(PSJSYSP0),"^",10) S IOP=$S($P($G(PSJSYSP0),"^",13)]"":$P($G(PSJSYSP0),"^",13),$P(PSJSYSW0,"^",19+X)]"":$P(PSJSYSW0,"^",19+X),1:"") I IOP]"" D
"RTN","PSJAC",42,0)
..S IOP="`"_IOP K %ZIS S %ZIS="NQ" D ^%ZIS S:'POP $P(PSJSYSL,"^",2,3)=ION_"^"_IO D HOME^%ZIS
"RTN","PSJAC",43,0)
;
"RTN","PSJAC",44,0)
D CLINIC
"RTN","PSJAC",45,0)
;
"RTN","PSJAC",46,0)
DONE ;
"RTN","PSJAC",47,0)
I PSJACPF<10 K VADM,VAIN,VAIP
"RTN","PSJAC",48,0)
K PSJACPF,PSGID,PSGOD,VA200,X
"RTN","PSJAC",49,0)
Q
"RTN","PSJAC",50,0)
HTWT(DFN) ; Get patient's height and weight from Vitals.
"RTN","PSJAC",51,0)
S (PSJPWTD,PSJPHTD)=""
"RTN","PSJAC",52,0)
S X="GMRVUTL" X ^%ZOSF("TEST") I S GMRVSTR="HT" D
"RTN","PSJAC",53,0)
. D EN6^GMRVUTL S PSJPHT=$P(X,U,8) S:PSJPHT PSJPHT=$J(2.54*PSJPHT,0,2),PSJPHTD="("_$S($D(PSJY2K):$E($$ENDTC2^PSGMI($P(X,U)),1,10),1:$E($$ENDTC^PSGMI($P(X,U)),1,8))_")"
"RTN","PSJAC",54,0)
. S GMRVSTR="WT" D EN6^GMRVUTL S PSJPWT=$P(X,U,8) S:PSJPWT PSJPWT=$J(PSJPWT/2.20462262,0,2),PSJPWTD="("_$S($D(PSJY2K):$E($$ENDTC2^PSGMI($P(X,U)),1,10),1:$E($$ENDTC^PSGMI($P(X,U)),1,8))_")"
"RTN","PSJAC",55,0)
F X="PSJPWT","PSJPHT" S:'$G(@X) @X="______"
"RTN","PSJAC",56,0)
F X="PSJPWTD","PSJPHTD" S:$G(@X)="" @X="(________)"
"RTN","PSJAC",57,0)
Q
"RTN","PSJAC",58,0)
PSJAC2(PSJY2K) ;
"RTN","PSJAC",59,0)
D PSJAC Q
"RTN","PSJAC",60,0)
Q
"RTN","PSJAC",61,0)
ACTCLIN(PSGP,PSGORD) ; Don't allow active clinic orders to be copied. If Pending order, allow CLINIC^PSJOE to reject based on order status.
"RTN","PSJAC",62,0)
N CLIN,CLNODE S CLIN=0
"RTN","PSJAC",63,0)
I $G(PSGORD)["P"!($G(PSGORD)=+$G(PSGORD)) S CLIN=0
"RTN","PSJAC",64,0)
I $G(PSGORD)["U" S CLNODE=$G(^PS(55,PSGP,5,+PSGORD,8)) I CLNODE&($P(CLNODE,"^",2)) S CLIN=1
"RTN","PSJAC",65,0)
I $G(PSGORD)["V" S CLNODE=$G(^PS(55,PSGP,"IV",+PSGORD,"DSS")) I CLNODE&($P(CLNODE,"^",2)) S CLIN=1
"RTN","PSJAC",66,0)
I $G(CLIN) W !!,"You cannot copy this CLINIC Order." D PAUSE^VALM1 Q 1
"RTN","PSJAC",67,0)
Q 0
"RTN","PSJAC",68,0)
;
"RTN","PSJAC",69,0)
CLINIC ; clinic parameters
"RTN","PSJAC",70,0)
N CL,CLIEN,CLNAM S CL=0 F S CL=$O(^PS(53.46,CL)) Q:'CL S CLIEN=$G(^(CL,0)) I CLIEN S PSJSYSW0("CLINIC",+CLIEN,0)=CLIEN I $D(^PS(53.46,CL,1)) S PSJSYSW0("CLINIC",+CLIEN,1)=^(1)
"RTN","PSJAC",71,0)
Q
"RTN","PSJHL4A")
0^4^B64737750^B64745608
"RTN","PSJHL4A",1,0)
PSJHL4A ;BIR/RLW - CONTINUE DECODE HL7 /MESSSAGE FROM OE/RR ;16 Mar 99 / 4:55 PM
"RTN","PSJHL4A",2,0)
;;5.0;INPATIENT MEDICATIONS ;**105,111,154,170,159,134,197,226,263,313,331**;16 DEC 97;Build 15
"RTN","PSJHL4A",3,0)
;
"RTN","PSJHL4A",4,0)
; Reference to ^PS(52.6 is supported by DBIA# 1231.
"RTN","PSJHL4A",5,0)
; Reference to ^PS(52.7 is supported by DBIA# 2173.
"RTN","PSJHL4A",6,0)
; Reference to ^PS(55 is supported by DBIA# 2191.
"RTN","PSJHL4A",7,0)
; Reference to ^PS(59.7 supported by DBIA #2181.
"RTN","PSJHL4A",8,0)
; Reference to ^ORHLESC is supported by DBIA# 4922.
"RTN","PSJHL4A",9,0)
; Reference to ^SC( is supported by DBIA# 10040.
"RTN","PSJHL4A",10,0)
; Reference to ^PS(51.1 is supported by DBIA# 2177.
"RTN","PSJHL4A",11,0)
; Reference to ^PS(50.7 is supported by DBIA #2180.
"RTN","PSJHL4A",12,0)
; Reference to ^PS(51.2 is supported by DBIA 2178.
"RTN","PSJHL4A",13,0)
;
"RTN","PSJHL4A",14,0)
RXC ; IV order
"RTN","PSJHL4A",15,0)
N IVFL,INACT,I,SELECTED,STRGTH
"RTN","PSJHL4A",16,0)
S APPL=FIELD(1)
"RTN","PSJHL4A",17,0)
I APPL["B" S SOLCNT=SOLCNT+1,PTR=$P(FIELD(2),"^",4) Q:'PTR S VOLUME=FIELD(3)_" ML" D I '$D(^TMP("PSJNVO",$J,"SOL",SOLCNT,0)) D SOLSRCH
"RTN","PSJHL4A",18,0)
.S SOLUTION=""
"RTN","PSJHL4A",19,0)
.F S SOLUTION=$O(^PS(52.7,"AOI",PTR,SOLUTION)) Q:'SOLUTION D
"RTN","PSJHL4A",20,0)
..S INACT=+$G(^PS(52.7,SOLUTION,"I")) I INACT,'(INACT>DT) Q ; IV Solution is INACTIVE
"RTN","PSJHL4A",21,0)
..I +VOLUME'=+$P(^PS(52.7,SOLUTION,0),U,3) Q ; IV Solution Volume does not Match
"RTN","PSJHL4A",22,0)
..S IVFL=$P($G(^PS(52.7,SOLUTION,0)),"^",13) I 'IVFL Q ; IV Solution Not Used in the IV Fluid Order
"RTN","PSJHL4A",23,0)
..S ^TMP("PSJNVO",$J,"SOL",0)=SOLCNT
"RTN","PSJHL4A",24,0)
..S ^TMP("PSJNVO",$J,"SOL",SOLCNT,0)=SOLUTION_"^"_VOLUME,TVOLUME=TVOLUME+(+VOLUME)
"RTN","PSJHL4A",25,0)
I $G(INFRT)]"" S X=INFRT D ENI^PSJHLU S INFRT=$G(X)
"RTN","PSJHL4A",26,0)
I APPL="A" S ADCNT=ADCNT+1,PTR=$P(FIELD(2),"^",4) Q:'PTR D
"RTN","PSJHL4A",27,0)
.S STRENGTH=$G(FIELD(3))_" "_$P($G(FIELD(4)),"^",5) D
"RTN","PSJHL4A",28,0)
.S ADDITIVE="",SELECTED=0
"RTN","PSJHL4A",29,0)
.F S ADDITIVE=$O(^PS(52.6,"AOI",PTR,ADDITIVE)) Q:'ADDITIVE D
"RTN","PSJHL4A",30,0)
..I $G(PSITEM)="" S PSITEM=PTR
"RTN","PSJHL4A",31,0)
..I $G(^PS(52.6,ADDITIVE,0))']"" Q
"RTN","PSJHL4A",32,0)
..S INACT=$G(^PS(52.6,ADDITIVE,"I")) I INACT,'(INACT>DT) Q ; IV Additive is INACTIVE
"RTN","PSJHL4A",33,0)
..S IVFL=$P($G(^PS(52.6,ADDITIVE,0)),"^",13) I 'IVFL Q ; IV Additive Not Used in the IV Fluid Order
"RTN","PSJHL4A",34,0)
..S STRGTH=$P($G(^PS(52.6,ADDITIVE,0)),"^",15)
"RTN","PSJHL4A",35,0)
..I 'SELECTED!(+$G(FIELD(3))&(+$G(FIELD(3))=+STRGTH)) S SELECTED=ADDITIVE
"RTN","PSJHL4A",36,0)
..;Store the bag data ("" = all bag, "S" = See comment, Numeric valure = bottle #)
"RTN","PSJHL4A",37,0)
.I SELECTED D
"RTN","PSJHL4A",38,0)
..S ^TMP("PSJNVO",$J,"AD",0)=ADCNT
"RTN","PSJHL4A",39,0)
..S ^TMP("PSJNVO",$J,"AD",ADCNT,0)=SELECTED_"^"_STRENGTH_"^"_$S($P($G(FIELD(5)),U)="S":"See Comments",('+$P($G(FIELD(5)),U)):"",1:$P($G(FIELD(5)),U))
"RTN","PSJHL4A",40,0)
I APPL="A",'$D(^TMP("PSJNVO",$J,"AD",ADCNT,0)) S PSREASON="Can't find matching additive" D ERROR^PSJHL9 Q
"RTN","PSJHL4A",41,0)
Q
"RTN","PSJHL4A",42,0)
;
"RTN","PSJHL4A",43,0)
RXO ;
"RTN","PSJHL4A",44,0)
I $O(PSJMSG(II,0)) D
"RTN","PSJHL4A",45,0)
.K SEGMENT
"RTN","PSJHL4A",46,0)
.N KK,JJ,XX
"RTN","PSJHL4A",47,0)
.S SEGMENT(1)=$G(PSJMSG(II))
"RTN","PSJHL4A",48,0)
.S KK=1,JJ="" F S JJ=$O(PSJMSG(II,JJ)) Q:'JJ S KK=KK+1,SEGMENT(KK)=$G(PSJMSG(II,JJ))
"RTN","PSJHL4A",49,0)
.S KK=1,JJ=0
"RTN","PSJHL4A",50,0)
.F Q:'$D(SEGMENT(KK)) D
"RTN","PSJHL4A",51,0)
..I SEGMENT(KK)["|" S FIELD(JJ)=$P(SEGMENT(KK),"|"),SEGMENT(KK)=$E(SEGMENT(KK),$L(FIELD(JJ))+2,$L(SEGMENT(KK))),JJ=JJ+1 Q
"RTN","PSJHL4A",52,0)
..I SEGMENT(KK)'["|" S FIELD(JJ)=SEGMENT(KK),KK=KK+1 Q:'$D(SEGMENT(KK)) D
"RTN","PSJHL4A",53,0)
...S XX=$P(SEGMENT(KK),"|"),SEGMENT(KK)=$E(SEGMENT(KK),$L(X)+2,$L(SEGMENT(KK))),FIELD(JJ)=FIELD(JJ)_XX,JJ=JJ+1
"RTN","PSJHL4A",54,0)
S APPL="",PSITEM=$S($P(FIELD(1),"^",5)="IV":"",1:$P(FIELD(1),"^",4))
"RTN","PSJHL4A",55,0)
S:$P(FIELD(1),"^",6)="ORD" PSITEM=""
"RTN","PSJHL4A",56,0)
S:$P(FIELD(1),"^",5)="IV" IVTYP="A",SCHTYP="C",INFRT=$G(FIELD(2))
"RTN","PSJHL4A",57,0)
S DISPENSE=$P($G(FIELD(10)),"^",4)
"RTN","PSJHL4A",58,0)
S IVLIMIT=$P($G(PSJMSG(II)),"^",3)
"RTN","PSJHL4A",59,0)
S:IVLIMIT["doses" IVLIMIT=$TR(IVLIMIT,"doses","a")
"RTN","PSJHL4A",60,0)
Q
"RTN","PSJHL4A",61,0)
;
"RTN","PSJHL4A",62,0)
OBX ;
"RTN","PSJHL4A",63,0)
S OBXFL=1,OCNARR=FIELD(5),OCPROV=CLERK,OCCNT=OCCNT+1
"RTN","PSJHL4A",64,0)
S ^TMP("PSJNVO",$J,10,0)=OCCNT
"RTN","PSJHL4A",65,0)
S ^TMP("PSJNVO",$J,10,OCCNT,0)=OCNARR
"RTN","PSJHL4A",66,0)
S ^TMP("PSJNVO",$J,10,OCCNT,1)=$$UNESC^ORHLESC($P($G(^VA(200,+OCPROV,0)),"^"))
"RTN","PSJHL4A",67,0)
Q
"RTN","PSJHL4A",68,0)
;
"RTN","PSJHL4A",69,0)
NTE ;
"RTN","PSJHL4A",70,0)
S TEXT=$S((FIELD(1)=6)&('OBXFL):"PROCOM",(FIELD(1)=7)&('OBXFL):"ADMINSTR",1:"OCRSN")
"RTN","PSJHL4A",71,0)
S @TEXT@(1)=$$UNESC^ORHLESC($G(FIELD(3)))
"RTN","PSJHL4A",72,0)
S K=1,J="" F S J=$O(PSJMSG(II,J)) Q:'J S K=K+1,@TEXT@(K)=$G(PSJMSG(II,J))
"RTN","PSJHL4A",73,0)
D:$D(OCRSN)
"RTN","PSJHL4A",74,0)
.S QQ=0 F S QQ=$O(OCRSN(QQ)) Q:'QQ S ^TMP("PSJNVO",$J,10,OCCNT,2,QQ,0)=OCRSN(QQ)
"RTN","PSJHL4A",75,0)
S OBXFL=0
"RTN","PSJHL4A",76,0)
Q
"RTN","PSJHL4A",77,0)
;
"RTN","PSJHL4A",78,0)
ZRX ;
"RTN","PSJHL4A",79,0)
N ND,ND2,CHK,FOLOR,STDT
"RTN","PSJHL4A",80,0)
S PREON=$G(FIELD(1)),ROC=$G(FIELD(3)),IVCAT=$G(FIELD(6))
"RTN","PSJHL4A",81,0)
S IVCAT=$S(",I,C,"[(","_IVCAT_","):IVCAT,1:"") S IVTYP=$S($G(PSGS0XT):"P",1:"A") S IVTYP=$S(IVCAT="I":"P",IVCAT="C":"A",1:$G(IVTYP))
"RTN","PSJHL4A",82,0)
; HD281238 - No longer checked for PREON before setting IVTYP
"RTN","PSJHL4A",83,0)
S ND=$S((PREON["N")!(PREON["P"):$G(^PS(53.1,+PREON,0)),PREON["V":$G(^PS(55,PSJHLDFN,"IV",+PREON,0)),1:$G(^PS(55,PSJHLDFN,5,+PREON,0)))
"RTN","PSJHL4A",84,0)
S ND2=$S((PREON["N")!(PREON["P"):$G(^PS(53.1,+PREON,2)),PREON["V":$G(^PS(55,PSJHLDFN,"IV",+PREON,2)),1:$G(^PS(55,PSJHLDFN,5,+PREON,2)))
"RTN","PSJHL4A",85,0)
I 'ND I ROC'="N" S PSREASON="Invalid Pharmacy order number" D ERROR^PSJHL9 Q
"RTN","PSJHL4A",86,0)
I ND I ROC="R" S FOLOR=$S(PREON["V":$P(ND2,U,6),1:$P(ND,U,26)) I FOLOR S PSREASON="Duplicate Renewal Request" D ERROR^PSJHL9 Q
"RTN","PSJHL4A",87,0)
I ND I ROC="R" S CHK=$S(PREON["V":$P(ND,U,17),1:$P(ND,U,9)) I "AE"'[CHK S PSREASON="Pharmacy orders with a status of "_CHK_" may not be renewed" D ERROR^PSJHL9 Q
"RTN","PSJHL4A",88,0)
I $G(CHK)="E" I PREON'["V" D NOW^%DTC S X1=+$E(%,1,12),X2=-4 D C^%DTC S STDT=$S(PREON["V":$P(ND,U,3),1:$P(ND2,U,4)) I STDT'>X S PSREASON="Pharmacy orders expired longer than 4 days may not be renewed" D ERROR^PSJHL9 Q
"RTN","PSJHL4A",89,0)
I ND I ROC="E" S FOLOR=$S(PREON["V":$P(ND2,U,6),1:$P(ND,U,26)) I FOLOR S PSREASON="Pharmacy orders may only be edited ONCE" D ERROR^PSJHL9 Q
"RTN","PSJHL4A",90,0)
I ND I ROC="E" S CHK=$S(PREON["V":$P(ND,U,17),1:$P(ND,U,9)) I "DEHO"[CHK N CHKRTN S CHKRTN=CHK_"^PSJHL6" D @CHKRTN S PSREASON=PSREASON_" orders may not be edited" D ERROR^PSJHL9 Q
"RTN","PSJHL4A",91,0)
D:ROC'="R" VALID^PSJHL9 Q:QFLG
"RTN","PSJHL4A",92,0)
I $G(PSITEM)="",$D(^TMP("PSJNVO",$J,"SOL",1,0)) S PSITEM=$P($G(^PS(52.7,+^TMP("PSJNVO",$J,"SOL",1,0),0)),"^",11)
"RTN","PSJHL4A",93,0)
I PRIORITY="ZD" D VALID^PSJHL10 S QFLG=1 Q
"RTN","PSJHL4A",94,0)
I (PREON]"")&(ROC="E") D EDITCK^PSJHL5 Q:QFLG
"RTN","PSJHL4A",95,0)
D NVO^PSJHL9
"RTN","PSJHL4A",96,0)
I (PREON]"")&(ROC="R") D RENEW^PSJHL7 Q
"RTN","PSJHL4A",97,0)
I (PREON]"")&(ROC="E") D EDIT^PSJHL5
"RTN","PSJHL4A",98,0)
Q
"RTN","PSJHL4A",99,0)
;
"RTN","PSJHL4A",100,0)
SOLSRCH ;Find solution
"RTN","PSJHL4A",101,0)
N SSSS,SEG,ON,ROC,SOL,SOL2
"RTN","PSJHL4A",102,0)
F SSSS=II:0 S SSSS=$O(PSJMSG(SSSS)) Q:'SSSS I $P(PSJMSG(SSSS),"|")="ZRX" D Q
"RTN","PSJHL4A",103,0)
.S SEG=$G(PSJMSG(SSSS)),ON=$P(SEG,"|",2),ROC=$P(SEG,"|",4)
"RTN","PSJHL4A",104,0)
I $G(ROC)'="N" F SOL=0:0 S SOL=$O(^PS(55,PSJHLDFN,"IV",+ON,"SOL",SOL)) Q:'SOL S SOL2=$G(^PS(55,PSJHLDFN,"IV",+ON,"SOL",SOL,0)) I $D(^PS(52.7,"AOI",PTR,+SOL2))&($P(SOL2,U,2)=VOLUME) S SOLUTION=+SOL2 D SET Q
"RTN","PSJHL4A",105,0)
I 'SOLUTION S SOLUTION=$O(^PS(52.7,"AOI",PTR,SOLUTION)) D SET
"RTN","PSJHL4A",106,0)
Q
"RTN","PSJHL4A",107,0)
SET ;Set solution tmp nodes
"RTN","PSJHL4A",108,0)
Q:'+SOLUTION
"RTN","PSJHL4A",109,0)
S ^TMP("PSJNVO",$J,"SOL",0)=SOLCNT
"RTN","PSJHL4A",110,0)
S ^TMP("PSJNVO",$J,"SOL",SOLCNT,0)=SOLUTION_"^"_VOLUME,TVOLUME=TVOLUME+(+VOLUME)
"RTN","PSJHL4A",111,0)
Q
"RTN","PSJHL4A",112,0)
;
"RTN","PSJHL4A",113,0)
SNDTSTW(PRIO,PSJSCHED,WARD) ; Test to determine if mail message should be sent.
"RTN","PSJHL4A",114,0)
N SNPRIO,SNSCHD,SNOPT
"RTN","PSJHL4A",115,0)
S SNPRIO=$S(PRIO="S":"S",PRIO="A":"A",1:"R")
"RTN","PSJHL4A",116,0)
S SNSCHD=$S(PSJSCHED="STAT":"S",PSJSCHED="NOW":"N",1:"R")
"RTN","PSJHL4A",117,0)
S SNOPT=$P($G(^PS(59.6,WARD,0)),"^",32)
"RTN","PSJHL4A",118,0)
S:SNOPT="" SNOPT=$P($G(^PS(59.7,1,27)),"^",1)
"RTN","PSJHL4A",119,0)
Q:SNOPT="" 0
"RTN","PSJHL4A",120,0)
Q:SNOPT[SNPRIO 0
"RTN","PSJHL4A",121,0)
Q:SNOPT[SNSCHD 0
"RTN","PSJHL4A",122,0)
Q 1
"RTN","PSJHL4A",123,0)
;
"RTN","PSJHL4A",124,0)
SNDTSTP(PRIO,PSJSCHED) ; Test to determine if mail message should be sent.
"RTN","PSJHL4A",125,0)
N SNPRIO,SNSCHD,SNOPT
"RTN","PSJHL4A",126,0)
S SNPRIO=$S(PRIO="S":"S",PRIO="A":"A",1:"R")
"RTN","PSJHL4A",127,0)
S SNSCHD=$S(PSJSCHED="STAT":"S",PSJSCHED="NOW":"N",1:"R")
"RTN","PSJHL4A",128,0)
S SNOPT=$P($G(^PS(59.7,1,27)),"^",1)
"RTN","PSJHL4A",129,0)
Q:SNOPT="" 1
"RTN","PSJHL4A",130,0)
Q:SNOPT[SNPRIO 0
"RTN","PSJHL4A",131,0)
Q:SNOPT[SNSCHD 0
"RTN","PSJHL4A",132,0)
Q 1
"RTN","PSJHL4A",133,0)
;
"RTN","PSJHL4A",134,0)
SNDTSTA(PRIO,PSJSCHED) ; Test to determine if mail message should be sent.
"RTN","PSJHL4A",135,0)
N SNPRIO,SNSCHD,SNOPT
"RTN","PSJHL4A",136,0)
S SNPRIO=$S(PRIO="S":"S",PRIO="A":"A",1:"R")
"RTN","PSJHL4A",137,0)
S SNSCHD=$S(PSJSCHED="STAT":"S",PSJSCHED="NOW":"N",1:"R")
"RTN","PSJHL4A",138,0)
S SNOPT=$P($G(^PS(59.7,1,27)),"^",2)
"RTN","PSJHL4A",139,0)
S:SNOPT="" SNOPT=$P($G(^PS(59.7,1,27)),"^",1)
"RTN","PSJHL4A",140,0)
Q:SNOPT="" 1
"RTN","PSJHL4A",141,0)
Q:SNOPT[SNPRIO 0
"RTN","PSJHL4A",142,0)
Q:SNOPT[SNSCHD 0
"RTN","PSJHL4A",143,0)
Q 1
"RTN","PSJHL4A",144,0)
;
"RTN","PSJHL4A",145,0)
TMPAT(SCHEDULE) ; Extract admin times from schedule in format schedule@schedule
"RTN","PSJHL4A",146,0)
S TMPAT="" I SCHEDULE'["@" Q TMPAT
"RTN","PSJHL4A",147,0)
S TMPAT=$P(SCHEDULE,"@",2) I TMPAT]"" D
"RTN","PSJHL4A",148,0)
.N WARD S WARD=$G(^DPT(PSJHLDFN,.1)) I WARD]"" D
"RTN","PSJHL4A",149,0)
..N DIC,X,Y S DIC="^DIC(42,",DIC(0)="BOXZ",X=WARD D ^DIC S WARD=+Y Q:WARD=0
"RTN","PSJHL4A",150,0)
..S WARD=$O(^PS(59.6,"B",WARD,0))
"RTN","PSJHL4A",151,0)
.I '$D(^PS(51.1,"AC","PSJ",TMPAT)) S TMPAT="" Q
"RTN","PSJHL4A",152,0)
.N II I '$$DOW^PSIVUTL($P(SCHEDULE,"@")) S TMPAT="" Q
"RTN","PSJHL4A",153,0)
.N TMPIEN S TMPIEN=$O(^PS(51.1,"AC","PSJ",TMPAT,0)),TMPAT=$P($G(^PS(51.1,+TMPIEN,0)),"^",2) D
"RTN","PSJHL4A",154,0)
..I $P($G(^PS(51.1,+TMPIEN,1,+$G(WARD),0)),"^",2) S TMPAT=$P($G(^(0)),"^",2)
"RTN","PSJHL4A",155,0)
Q TMPAT
"RTN","PSJHL4A",156,0)
;
"RTN","PSJHL4A",157,0)
XMD ; Mailman call for NOTIFY^PSJHL4
"RTN","PSJHL4A",158,0)
; Input - PNAME = Patient Name
"RTN","PSJHL4A",159,0)
; RTE = Route
"RTN","PSJHL4A",160,0)
; DRUG = Drug Name
"RTN","PSJHL4A",161,0)
; WARD = Ward Name
"RTN","PSJHL4A",162,0)
; CLINIC = Clinic Location Name
"RTN","PSJHL4A",163,0)
; PRIO = CPRS Order Priority
"RTN","PSJHL4A",164,0)
S PNAME=$P($G(^DPT(+PSJHLDFN,0)),"^") S:$G(RTE) RTE=$P(^PS(51.2,+RTE,0),"^",3)
"RTN","PSJHL4A",165,0)
S DRUG=$S(DRIEN:$P($G(^PS(50.7,+DRIEN,0)),"^"),1:""),WARD=$G(^DPT(PSJHLDFN,.1))
"RTN","PSJHL4A",166,0)
I $G(CLINIC)'="" S CLINIC=$P($G(^SC(CLINIC,0)),"^",2) I CLINIC'="" S WARD=CLINIC
"RTN","PSJHL4A",167,0)
S XMDUZ="MEDICATIONS,INPATIENT",XMSUB=$G(WARD)
"RTN","PSJHL4A",168,0)
S XMSUB=XMSUB_"-"_NTFSTAT_" "_$S($G(PRIO)="A":"ASAP",$G(PRIO)="S":"STAT",$G(NTFYREAS)=2:"NOW",$G(NTFYREAS)=3:"STAT",1:"")_"-"
"RTN","PSJHL4A",169,0)
S XMSUB=XMSUB_$E(PNAME,1,65-$L(XMSUB))
"RTN","PSJHL4A",170,0)
S XMTEXT="PSG("
"RTN","PSJHL4A",171,0)
S PSG(1,0)="Inpatient Medications has received the following "_$S($G(PRIO)="A":"ASAP",$G(PRIO)="S":"STAT",$G(NTFYREAS)=2:"NOW",1:"")_" order ("_NTFSTAT_")"
"RTN","PSJHL4A",172,0)
S PSG(2,0)=""
"RTN","PSJHL4A",173,0)
S PSG(3,0)=" Patient: "_PNAME I $G(LASTFOUR) S PSG(3,0)=PSG(3,0)_" ("_LASTFOUR_")"
"RTN","PSJHL4A",174,0)
S PSG(4,0)="Order Information: "_DRUG_" "_DO_" "_RTE_" "_$G(PSJSCHED)
"RTN","PSJHL4A",175,0)
S PSG(5,0)=" Order Date: "_$$ENDTC^PSGMI(ORDATE)
"RTN","PSJHL4A",176,0)
D ^XMD
"RTN","PSJHL4A",177,0)
Q
"RTN","PSJLMHED")
0^5^B56836733^B56770438
"RTN","PSJLMHED",1,0)
PSJLMHED ;BIR/MLM - BUILD LM HEADERS ; 8/6/14 11:00am
"RTN","PSJLMHED",2,0)
;;5.0;INPATIENT MEDICATIONS;**4,58,85,110,148,181,260,275,331**;16 DEC 97;Build 15
"RTN","PSJLMHED",3,0)
;
"RTN","PSJLMHED",4,0)
; Reference to ^PS(55 is supported by DBIA 2191.
"RTN","PSJLMHED",5,0)
; Reference to CWAD^ORQPT2 is supported by DBIA 2831.
"RTN","PSJLMHED",6,0)
; Reference to ^SC is supported by DBIA 10040.
"RTN","PSJLMHED",7,0)
; External reference to $$BSA^PSSDSAPI supported by DBIA 5425.
"RTN","PSJLMHED",8,0)
; External reference to ^ORQQVI supported by DBIA 5770.
"RTN","PSJLMHED",9,0)
; External reference to ^ORQPTQ4 supported by DBIA 5785.
"RTN","PSJLMHED",10,0)
; External reference to ^ORB31 supported by DBIA 5140.
"RTN","PSJLMHED",11,0)
; External reference to ^ORQQLR1 supported by DBIA 5787.
"RTN","PSJLMHED",12,0)
;
"RTN","PSJLMHED",13,0)
HDR(DFN) ; -- list screen header
"RTN","PSJLMHED",14,0)
; input: DFN := ifn of pat
"RTN","PSJLMHED",15,0)
; output: VALMHDR() := hdr array
"RTN","PSJLMHED",16,0)
;
"RTN","PSJLMHED",17,0)
K VAIN,VADM,GMRA,PSJACNWP,PSJ,VAERR,VA,X
"RTN","PSJLMHED",18,0)
S PSJACNWP=1 D ENBOTH^PSJAC
"RTN","PSJLMHED",19,0)
D HDRO(DFN)
"RTN","PSJLMHED",20,0)
S PSJ=" Sex: "_$P(PSJPSEX,U,2),VALMHDR(4)=$$SETSTR^VALM1($S(PSJPDD:"Last ",1:" ")_"Admitted: "_$P(PSJPAD,U,2),PSJ,45,23)
"RTN","PSJLMHED",21,0)
S PSJ=" Dx: "_PSJPDX
"RTN","PSJLMHED",22,0)
S:PSJPDD VALMHDR(5)=$$SETSTR^VALM1("Discharged: "_$E($P(PSJPDD,U,2),1,8),PSJ,48,26)
"RTN","PSJLMHED",23,0)
S:'PSJPDD VALMHDR(5)=$$SETSTR^VALM1("Last transferred: "_$$ENDTC^PSGMI(PSJPTD),PSJ,42,26)
"RTN","PSJLMHED",24,0)
S PSJBSA=$$BSA^PSSDSAPI(DFN),PSJBSA=$P(PSJBSA,"^",3),PSJBSA=$S(PSJBSA'>0:"__________",1:$J(PSJBSA,4,2))
"RTN","PSJLMHED",25,0)
S RSLT=$$CRCL(DFN)
"RTN","PSJLMHED",26,0)
I $P(RSLT,"^",2)["Not Found" S ZDSPL=" CrCL: "_$P(RSLT,"^",2)
"RTN","PSJLMHED",27,0)
E S ZDSPL=" CrCL: "_$P($G(RSLT),"^",2)_"(est.) "_"(CREAT:"_$P($G(RSLT),"^",3)_"mg/dL "_$P($G(RSLT),"^")_")"
"RTN","PSJLMHED",28,0)
S PSJDB=$G(ZDSPL),VALMHDR(6)=$$SETSTR^VALM1("BSA (m2): "_$G(PSJBSA),PSJDB,50,23) K PSJBSA
"RTN","PSJLMHED",29,0)
Q
"RTN","PSJLMHED",30,0)
;
"RTN","PSJLMHED",31,0)
HDRO(DFN) ; Standardized part of profile header.
"RTN","PSJLMHED",32,0)
N PSJCLIN,PSJAPPT,PSJCLINN,RMORDT S (PSJCLIN,PSJAPPT)=0,(RMORDAT,PSJCLINN)="" I $G(PSJORD) D
"RTN","PSJLMHED",33,0)
. S PSJCLIN=$S($G(PSJORD)["V":$G(^PS(55,DFN,"IV",+PSJORD,"DSS")),$G(PSJORD)["U":$G(^PS(55,DFN,5,+PSJORD,8)),$G(PSJORD)["P":$G(^PS(53.1,+PSJORD,"DSS")),1:"")
"RTN","PSJLMHED",34,0)
. S:PSJCLIN PSJAPPT=$P($G(PSJCLIN),U,2) S:'PSJAPPT PSJCLIN="" I PSJCLIN,PSJAPPT S PSJCLINN=$P($G(^SC(+PSJCLIN,0)),U)
"RTN","PSJLMHED",35,0)
K VALMHDR I PSJCLINN]"" S PSJ=VADM(1),PSJ=$$SETSTR^VALM1(" Clinic: "_PSJCLINN,PSJ,28,26)
"RTN","PSJLMHED",36,0)
I PSJCLINN="" S PSJ=VADM(1),PSJ=$$SETSTR^VALM1($S('PSJPDD:" ",1:"Last ")_"Ward: "_PSJPWDN,PSJ,30,18)
"RTN","PSJLMHED",37,0)
S X=$$CWAD^ORQPT2(DFN)
"RTN","PSJLMHED",38,0)
S:X]"" X=IORVON_X_IORVOFF,PSJ=$$SETSTR^VALM1(X,PSJ,80-$L(X),80) S VALMHDR(1)=PSJ
"RTN","PSJLMHED",39,0)
S PSJ=" PID: "_$P(PSJPSSN,U,2)
"RTN","PSJLMHED",40,0)
S RMORDT=$S($G(PSJPDD):"Last ",1:" ")_"Room-Bed: "_$G(PSJPRB)
"RTN","PSJLMHED",41,0)
I PSJCLINN]"",PSJAPPT S RMORDT="Clinic Date: "_$$ENDTC^PSGMI(PSJAPPT),RMORDT=$P(RMORDT," ")_" "_$P(RMORDT," ",2)
"RTN","PSJLMHED",42,0)
S PSJ=$$SETSTR^VALM1(RMORDT,PSJ,26,28),VALMHDR(2)=$$SETSTR^VALM1("Ht(cm): "_PSJPHT_" "_PSJPHTD,PSJ,55,25)
"RTN","PSJLMHED",43,0)
S PSJ=" DOB: "_$P($P(PSJPDOB,U,2)," ")_" ("_PSJPAGE_")",VALMHDR(3)=$$SETSTR^VALM1("Wt(kg): "_PSJPWT_" "_PSJPWTD,PSJ,55,25)
"RTN","PSJLMHED",44,0)
Q
"RTN","PSJLMHED",45,0)
;
"RTN","PSJLMHED",46,0)
INIT(PSJPROT) ; -- init bld vars
"RTN","PSJLMHED",47,0)
; PSJPROT=1:UD ONLY; 2:IV ONLY; 3:BOTH
"RTN","PSJLMHED",48,0)
K PSJUDPRF,^TMP("PSJ",$J),^TMP("PSJON",$J),^TMP("PSJPRO",$J)
"RTN","PSJLMHED",49,0)
S:PSJPROT=1 PSJUDPRF=1
"RTN","PSJLMHED",50,0)
D KILL^VALM10(),EN^PSJO1(PSJPROT)
"RTN","PSJLMHED",51,0)
I '$D(^TMP("PSJ",$J)) W !!,?22,"NO ORDERS FOUND FOR "_$S(PSJOL="S":"SHORT",1:"LONG")_" PROFILE." S VALMQUIT=1 D PAUSE^PSJLMUTL Q
"RTN","PSJLMHED",52,0)
S PSJTF=0,PSJLN=1,PSJEN=1,PSJC="" F S PSJC=$O(^TMP("PSJ",$J,PSJC)) Q:PSJC=""!(PSJC["^") D
"RTN","PSJLMHED",53,0)
.S PSJF="^PS("_$S("AO"[PSJC:"55,"_PSGP_",5,",PSJC="DF":"55,"_PSGP_",5,",1:"53.1,")
"RTN","PSJLMHED",54,0)
.I PSJTF'=$E(PSJC,1)!(PSJC="CC")!(PSJC="CD")!(PSJC="BD") Q:PSJC="CB" Q:PSJC="O" Q:PSJC="DF" D TF S PSJTF=$E(PSJC,1) ;DAM 8-29-07 Added Q:PSJC="CB" Q:PSJC="O"
"RTN","PSJLMHED",55,0)
.S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:PSJST="" D
"RTN","PSJLMHED",56,0)
..S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="" Q:PSJC="CB" Q:PSJC="O" Q:PSJC="DF" D ON ;DAM 8-29-07 Added Q:PSJC="CB" Q:PSJC="O"
"RTN","PSJLMHED",57,0)
.;
"RTN","PSJLMHED",58,0)
.;DAM 8-29-07 New code to place Pending Orders after Pending Renewal Orders on the roll and scroll display. Non-Active Orders appear last.
"RTN","PSJLMHED",59,0)
S PSJTF=0,PSJC="" F S PSJC=$O(^TMP("PSJ",$J,PSJC)) Q:PSJC="" D
"RTN","PSJLMHED",60,0)
. S PSJF="^PS("_$S("AO"[PSJC:"55,"_PSGP_",5,",PSJC="DF":"55,"_PSGP_",5,",1:"53.1,")
"RTN","PSJLMHED",61,0)
. I PSJC="CB" D TF S PSJTF=$E(PSJC,1) ;These are Pending Orders
"RTN","PSJLMHED",62,0)
. I PSJC="CB" S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:PSJST="" D
"RTN","PSJLMHED",63,0)
. . S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="" D ON
"RTN","PSJLMHED",64,0)
. ;
"RTN","PSJLMHED",65,0)
. I PSJC["Cz" D
"RTN","PSJLMHED",66,0)
. . N PSJCLIN
"RTN","PSJLMHED",67,0)
. . S PSJF="^PS("_$S("AO"[$P(PSJC,"^",4):"55,"_PSGP_",5,",$P(PSJC,"^",4)="DF":"55,"_PSGP_",5,",1:"53.1,")
"RTN","PSJLMHED",68,0)
. . S PSJCLIN=$P(PSJC,"^",2) Q:PSJCLIN=""
"RTN","PSJLMHED",69,0)
. . I ($P(PSJTF,"^",2)'=$P(PSJC,"^",2)) D TF S PSJTF=PSJC
"RTN","PSJLMHED",70,0)
. . S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:PSJST="" D
"RTN","PSJLMHED",71,0)
. . . S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="" D ON ;DAM 8-29-07 Added Q:PSJC="CB" Q:PSJC="O"
"RTN","PSJLMHED",72,0)
. ;
"RTN","PSJLMHED",73,0)
. I PSJC="DF" D TF S PSJTF=$E(PSJC,1) ;These are recently DC Orders (mv)
"RTN","PSJLMHED",74,0)
. I PSJC="DF" S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:PSJST="" D
"RTN","PSJLMHED",75,0)
. . S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="" D ON
"RTN","PSJLMHED",76,0)
. I PSJC="O" D TF S PSJTF=$E(PSJC,1) ;These are Non-Active Orders
"RTN","PSJLMHED",77,0)
. I PSJC="O" S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:PSJST="" D
"RTN","PSJLMHED",78,0)
. . S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="" D ON
"RTN","PSJLMHED",79,0)
.; END DAM changes
"RTN","PSJLMHED",80,0)
.;
"RTN","PSJLMHED",81,0)
S VALMCNT=PSJLN-1
"RTN","PSJLMHED",82,0)
DONE ;
"RTN","PSJLMHED",83,0)
K PSJC,PSJEN,PSJLN,PSJST,PSJS,CNT,PSJPRI,PSJORD
"RTN","PSJLMHED",84,0)
Q
"RTN","PSJLMHED",85,0)
;
"RTN","PSJLMHED",86,0)
ON ;
"RTN","PSJLMHED",87,0)
S PSJSCHT=$S(PSJOS:PSJS,1:PSJST)
"RTN","PSJLMHED",88,0)
S PSJO="" F FQ=0:0 S PSJO=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS,PSJO)) Q:PSJO="" S DN=^(PSJO) D
"RTN","PSJLMHED",89,0)
.N PRJPRI S PSJPRI=$S(PSJO["V":$P($G(^PS(55,PSGP,"IV",+PSJO,.2)),"^",4),PSJO["U":$P($G(^PS(55,PSGP,5,+PSJO,.2)),"^",4),1:$P($G(^PS(53.1,+PSJO,.2)),"^",4))
"RTN","PSJLMHED",90,0)
.S ^TMP("PSJON",$J,PSJEN)=PSJO,PSJL=$J(PSJEN,4) I ($P(PSJC,"^")="Cz") N PSJTMPJC S PSJTMPJC=PSJC N PSJC S PSJC=$P(PSJTMPJC,"^",4)
"RTN","PSJLMHED",91,0)
.D @$S(PSJO["V":"PIV^PSJLMPRI(PSGP,PSJO,PSJF,DN)",PSJO["U":"PUD^PSJLMPRU(PSGP,PSJO,PSJF,DN)",1:"PIV^PSJLMPRI(PSGP,PSJO,PSJF,DN)") S ^TMP("PSJPRO",$J,0)=PSJEN,PSJEN=PSJEN+1
"RTN","PSJLMHED",92,0)
Q
"RTN","PSJLMHED",93,0)
;
"RTN","PSJLMHED",94,0)
TF ; Set up order type header
"RTN","PSJLMHED",95,0)
NEW PSJDFHDR
"RTN","PSJLMHED",96,0)
I $D(^TMP("PSJ",$J,PSJC)) D
"RTN","PSJLMHED",97,0)
.S PSJDCEXP=$$RECDCEXP^PSJP()
"RTN","PSJLMHED",98,0)
.S PSJDFHDR="RECENTLY DISCONTINUED/EXPIRED (LAST "_+$G(PSJDCEXP)_" HOURS)"
"RTN","PSJLMHED",99,0)
.N C,X,Y S C=PSJC,Y="",$P(Y," -",40)=""
"RTN","PSJLMHED",100,0)
.S X=$S(($G(PSJCLIN)]""):$G(PSJCLIN),C="A":$$TXT^PSJO("A"),C["CC":$$TXT^PSJO("PR"),C["CD":$$TXT^PSJO("PC"),C["C":$$TXT^PSJO("P"),C["BD":$$TXT^PSJO("NC"),C["B":$$TXT^PSJO("N"),C["DF":PSJDFHDR,1:$$TXT^PSJO("NA"))
"RTN","PSJLMHED",101,0)
.S ^TMP("PSJPRO",$J,PSJLN,0)=$E($E(Y,1,(80-$L(X))/2)_" "_X_$E(Y,1,(80-$L(X))/2),1,80),PSJLN=PSJLN+1
"RTN","PSJLMHED",102,0)
Q
"RTN","PSJLMHED",103,0)
TEST ;
"RTN","PSJLMHED",104,0)
N X,Y S Y="",$P(Y," -",40)=""
"RTN","PSJLMHED",105,0)
F X="A C T I V E","P E N D I N G R E N E W A L S","P E N D I N G ","N O N - V E R I F I E D","N O N - A C T I V E" W !,$E($E(Y,1,(80-$L(X))/2)_" "_X_$E(Y,1,(80-$L(X))/2),1,80)
"RTN","PSJLMHED",106,0)
Q
"RTN","PSJLMHED",107,0)
CRCL(DFN) ;
"RTN","PSJLMHED",108,0)
N HTGT60,ABW,IBW,BWRATIO,BWDIFF,LOWBW,ADJBW,X1,X2,RSLT,PSCR,PSRW,ABW,ZHT,PSRH,PSCXTL,PSCXTLS,SCR,OCXT,OCXTS,SCRV,ZAGE,SEX
"RTN","PSJLMHED",109,0)
S RSLT="0^"
"RTN","PSJLMHED",110,0)
S PSCR="^^^^^^0"
"RTN","PSJLMHED",111,0)
D VITAL^ORQQVI("WEIGHT","WT",DFN,.PSRW,0,"",$$NOW^XLFDT)
"RTN","PSJLMHED",112,0)
Q:'$D(PSRW) RSLT
"RTN","PSJLMHED",113,0)
S ABW=$P(PSRW(1),U,3) Q:+$G(ABW)<1 RSLT
"RTN","PSJLMHED",114,0)
S ABW=ABW/2.20462262 ;ABW (actual body weight) in kg
"RTN","PSJLMHED",115,0)
D VITAL^ORQQVI("HEIGHT","HT",DFN,.PSRH,0,"",$$NOW^XLFDT)
"RTN","PSJLMHED",116,0)
Q:'$D(PSRH) RSLT
"RTN","PSJLMHED",117,0)
S ZHT=$P(PSRH(1),U,3) Q:+$G(ZHT)<1 RSLT
"RTN","PSJLMHED",118,0)
S ZAGE=$$AGE^ORQPTQ4(DFN) Q:'ZAGE RSLT
"RTN","PSJLMHED",119,0)
S SEX=$P($$SEX^ORQPTQ4(DFN),U,1) Q:'$L(SEX) RSLT
"RTN","PSJLMHED",120,0)
S PSCXTL="" Q:'$$TERMLKUP^ORB31(.PSCXTL,"SERUM CREATININE") RSLT
"RTN","PSJLMHED",121,0)
S PSCXTLS="" Q:'$$TERMLKUP^ORB31(.PSCXTLS,"SERUM SPECIMEN") RSLT
"RTN","PSJLMHED",122,0)
S SCR="",OCXT=0 F S OCXT=$O(PSCXTL(OCXT)) Q:'OCXT D
"RTN","PSJLMHED",123,0)
.S OCXTS=0 F S OCXTS=$O(PSCXTLS(OCXTS)) Q:'OCXTS D
"RTN","PSJLMHED",124,0)
..S SCR=$$LOCL^ORQQLR1(DFN,$P(PSCXTL(OCXT),U),$P(PSCXTLS(OCXTS),U))
"RTN","PSJLMHED",125,0)
..I $P(SCR,U,7)>$P(PSCR,U,7) S PSCR=SCR
"RTN","PSJLMHED",126,0)
S SCR=PSCR,SCRV=$P(SCR,U,3) Q:+$G(SCRV)<.01 RSLT
"RTN","PSJLMHED",127,0)
S SCRD=$P(SCR,U,7) Q:'$L(SCRD) RSLT
"RTN","PSJLMHED",128,0)
;
"RTN","PSJLMHED",129,0)
S HTGT60=$S(ZHT>60:(ZHT-60)*2.3,1:0) ;if ht > 60 inches
"RTN","PSJLMHED",130,0)
I HTGT60>0 D
"RTN","PSJLMHED",131,0)
.S IBW=$S(SEX="M":50+HTGT60,1:45.5+HTGT60) ;Ideal Body Weight
"RTN","PSJLMHED",132,0)
.S BWRATIO=(ABW/IBW) ;body weight ratio
"RTN","PSJLMHED",133,0)
.S BWDIFF=$S(ABW>IBW:ABW-IBW,1:0)
"RTN","PSJLMHED",134,0)
.S LOWBW=$S(IBW1.3,(BWDIFF>0) S ADJBW=((0.3*BWDIFF)+IBW)
"RTN","PSJLMHED",136,0)
.E S ADJBW=LOWBW
"RTN","PSJLMHED",137,0)
I +$G(ADJBW)<1 D
"RTN","PSJLMHED",138,0)
.S ADJBW=ABW
"RTN","PSJLMHED",139,0)
S CRCL=(((140-ZAGE)*ADJBW)/(SCRV*72))
"RTN","PSJLMHED",140,0)
;
"RTN","PSJLMHED",141,0)
S:SEX="M" RSLT=SCRD_U_$J(CRCL,1,1)
"RTN","PSJLMHED",142,0)
S:SEX="F" RSLT=SCRD_U_$J((CRCL*.85),1,1)
"RTN","PSJLMHED",143,0)
S X1=$P(RSLT,"^"),X2=$$FMTE^XLFDT(X1,"2M"),$P(RSLT,"^")=$P(X2,"@") K X1,X2
"RTN","PSJLMHED",144,0)
S $P(RSLT,"^",3)=$P($G(SCR),"^",3)
"RTN","PSJLMHED",145,0)
K HTGT60,ABW,IBW,BWRATIO,BWDIFF,LOWBW,ADJBW,X1,X2,PSCR,PSRW,ABW,ZHT,PSRH,ZAGE,PSCXTL,PSCXTLS,SCR,OCXT,OCXTS,SCRV,CRCL
"RTN","PSJLMHED",146,0)
Q RSLT
"VER")
8.0^22.0
"BLD",10228,6)
^288
**END**
**END**