source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVLABL.m@ 1504

Last change on this file since 1504 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1PSIVLABL ;BIR/PR-PRINT OUT LABELS ;17 Aug 2001 9:33 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**58,82,104,127,178**;16 DEC 97;Build 9
3 ;
4 ; Reference to ^%ZIS(2 is supported by DBIA 3435.
5 ; Reference to ^PS(52.6 is supported by DBIA 1231.
6 ; Reference to ^PS(52.7 is supported by DBIA 2173.
7 ; Reference to ^PS(55 is supported by DBIA 2191.
8 ; Reference to ^PS(51.2 is supported by DBIA 2178.
9 ;
10 ;Needs DFN,ON, and PSIVNOL NOTE: If PSIVCT is defined then we do
11 ;not count labels in the STATs file or increment cummulative doses or
12 ;the last fill field.
13 ;PSIVCT will be defined if reprinting scheduled labels, the suspense
14 ;list, or if printing individual labels and they do not count.
15 ;
16DEM ;Get demographics and see if label is example only
17 N X0,PSJIO,I
18 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)
19 S PSJIO=$S('$D(PSJIO):0,1:1)
20 D ENIV^PSJAC,NOW^%DTC S PSIVNOW=$$ENDTC^PSGMI(%),VADM(2)=$E(VADM(2),6,9),PSIVWD=$S(+VAIN(4):$P(VAIN(4),U,2),1:"Opt. IV") I $D(PSIVEXAM) G ENX
21 ;
22 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
23 I PSJIO,$G(PSJIO("FI"))]"" X PSJIO("FI")
24 I $P(PSIVSITE,U,7) D
25 . S PSIVFLAG=1,(LINE,PSIV1)=0,PSIV2=PSIVNOL,PSIVNOL=0 D RE
26 . S PSIVRP="",PSIVRT=""
27 . I $D(^PS(55,DFN,"IV",+ON,.2)) S PSIVRP=$P(^PS(55,DFN,"IV",+ON,.2),U,3) D
28 .. 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.
29 .. S PSIVRT=$P(^PS(51.2,PSIVRP,0),U,1)
30 .. S X="ROUTE: "_PSIVRT D:X]"" PMR
31 . S X="Solution: _______________" D P S X="Additive: _______________" D P
32 . S PSIVNOL=PSIV2
33 . I 'PSJIO F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
34 . I PSJIO,$G(PSJIO("EL"))]"" X PSJIO("EL")
35 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
36 K PSIVFLAG,PSIVSH G START
37SETP S Y=^PS(55,DFN,"IV",+ON,0) F X=1:1:23 S P(X)=$P(Y,U,X)
38 Q
39ENX ;Print example label
40 D SETP S PSIVFLAG=1,PSIVRM=$P(PSIVSITE,U,13) S:PSIVRM<1 PSIVRM=30
41START F PSIV1=1:1:PSIVNOL D
42 . S LINE=0 D RE
43 . Q:$D(PSIVFLAG)
44 . I 'PSJIO F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
45 . I PSJIO,$G(PSJIO("EL"))]"" X PSJIO("EL")
46 I PSJIO,$G(PSJIO("FE"))]"" X PSJIO("FE")
47 D:'$D(PSIVCT) ^PSIVSTAT
48Q K PSIV,PSIVDOSE,PSIVWD,P16,LINE,MESS,PSIVCT,PSIV2,PSIVFLAG,PSIVRM,PSIV1,PDOSE,PDATE,XX1,XX2,BAG,CX Q
49RE ;
50 K DO
51 I PSIV1,P(4)="A"!(P(5)=0) S P(16)=PSIV1 I $G(PSIVT)]"" D
52 . 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
53 I PSIV1 S PSJBCID=$$BCMA^PSIVBCID(DFN,ON,$D(PSIVCT),$G(PSIV1),$G(PSIV2),$G(PSIVNOL))
54 ;* Only if prt from ward or man list then store BCMA ID to set xref for
55 ;* reprint later
56 I PSIV1,$G(PSIVWMFL) S PSIVID($P(PSJBCID,"V",2))=""
57 I PSJIO,$G(PSJIO("SL"))]"" X PSJIO("SL")
58 I PSIV1 D BARCODE
59 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) D P
60 S X=VADM(1) S:$P(PSIVSITE,U,9) X=X_" "_$S(VAIN(5)]"":VAIN(5),1:"NF") D P S X=" " D P
61 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
62 . D P
63 . ;I PSIV1 S YY=Y D UP2^PSIVBCID(DFN,PSJBLN,PSIV,YY) S Y=YY
64 . D MESS
65 G:$D(PSIVFLAG) SOL
66 ; 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
67 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
68 . D P
69 . I PSIV1 S YY=Y D UP2^PSIVBCID(DFN,PSJBLN,PSIV,YY) S Y=YY
70 . D MESS
71 ;
72SOL F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",+ON,"SOL",PSIV)) Q:'PSIV S PSIV=PSIV_"^"_+^(PSIV,0),YY=^(0) D
73 . D SOL1,P I PSIV1 D UP3^PSIVBCID(DFN,PSJBLN,PSIV,YY)
74 . S X=$P(^PS(52.7,$P(PSIV,U,2),0),U,4) I X]"" S X=" "_X D P
75 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
76 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
77 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
78 ;
79MEDRT ;Find Medication Route
80 S PSIVRP="",PSIVRT=""
81 I $D(^PS(55,DFN,"IV",+ON,.2)) S PSIVRP=$P(^PS(55,DFN,"IV",+ON,.2),U,3) D
82 .S PSIVRT=$P(^PS(51.2,PSIVRP,0),U,1)
83 .S X="ROUTE: "_PSIVRT D:X]"" PMR
84 ;
85INF S X=$P(P(8),"@") D:X]"" P
86 I $D(^PS(55,DFN,"IV",+ON,3)) S X=$P(^(3),"^") D:X]"" P
87 S X=P(9) D:X]"" P
88 S X=P(11) D:X]"" P
89 I $D(MESS) S X=MESS D P
90 I $D(^PS(59.5,PSIVSN,4)) S Y=^(4) F PSIV=1:1 S X=$P(Y,U,PSIV) Q:X="" D P
91 S X=PSIV1_"["_$S(PSIV1:PSIVNOL,1:PSIV2)_"]"_" "_$S('PSIV1:PSIVNOW,1:"") D P
92 Q
93 ;
94P F LINE=LINE+1:1 D Q:$L(X)<1
95 . I LINE>PSIVSITE D
96 .. S LINE=1
97 .. I 'PSJIO D Q
98 ... F ZZ=1:1 Q:ZZ>$P(PSIVSITE,"^",16) W !
99 .. F I="EL","SL" I $G(PSJIO(I))]"" X PSJIO(I)
100 . K ZZ
101 . F I="ST","STF" I $G(PSJIO(I))]"" X PSJIO(I)
102 . W $E(X,1,PSIVRM)
103 . F I="ETF","ET" I $G(PSJIO(I))]"" X PSJIO(I)
104 . I 'PSJIO W !
105 . S X=$E(X,PSIVRM+1,999)
106 Q
107PMR ; Print Med Route on label
108 ;
109 F LINE=LINE+1:1 D Q:$L(X)<1
110 . I LINE>PSIVSITE D
111 .. S LINE=1
112 .. I 'PSJIO D Q
113 ... F ZZ=1:1 Q:ZZ>$P(PSIVSITE,"^",16) W !
114 .. F I="EL","SL" I $G(PSJIO(I))]"" X PSJIO(I)
115 . K ZZ
116 . ;
117 . F I="ST","STF","SM","SMF" I $G(PSJIO(I))]"" X PSJIO(I)
118 . W $E(X,1,PSIVRM)
119 . F I="ETF","ET","EMF","EM" I $G(PSJIO(I))]"" X PSJIO(I)
120 . I 'PSJIO W !
121 . S X=$E(X,PSIVRM+1,999)
122 Q
123 ;
124SOL1 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
125MESS I '$D(MESS) I $P(^PS(52.6,+Y,0),U,9)]"" S MESS=$P(^(0),U,9)
126 Q
127CONVER ;Expand dose to date.dose and set in X
128 I P(15)>1440 S X=$$CONVER1^PSIVORE2($P(PSIVDOSE," "),P(15),(PSIV1-1)) Q
129 S PDOSE=X S:PSIV1=2 PDATE=$E($P(PSIVDOSE," "),1,7)
130 I $P(PSIVDOSE," ",PSIV1-1)#1'<PDOSE!(P(15)>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
131 S X=PDATE_PDOSE
132 Q
133BARCODE D PSET^%ZISP
134 I 'PSJIO D
135 . I IOBARON]"" W @IOBARON
136 . W PSJBCID
137 . I IOBAROFF]"" W @IOBAROFF
138 . W !
139 I PSJIO D
140 . F I="SB","SBF" I $G(PSJIO(I))]"" X PSJIO(I)
141 . W PSJBCID
142 . F I="EBF","EB" I $G(PSJIO(I))]"" X PSJIO(I)
143 Q
Note: See TracBrowser for help on using the repository browser.