source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVUDL.m@ 1147

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1PSIVUDL ;BIR/PR,MLM-IV ORDER INFORMATION FOR UNIT DOSE LABEL ;25 Nov 98 / 9:12 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**21,58,110**;16 DEC 97
3 ;
4 ; References to ^PS(52.6 supported by DBIA #1231
5 ; References to ^PS(52.7 supported by DBIA #2173
6 ; References to ^PS(55 supported by DBIA #2191
7 ;
8 ;Needs DFN and PSJORD
9EN(DFN,ON,PSJLWD,PSJLRB) ; Entry to print MAR label for all types of IV orders.
10 N PSJLABEL,VAIN,VADM S (PSJACNWP,PSJLABEL)=1 D ENIV^PSJAC
11 S PSJTM=$S(PSJLRB]"":$P($G(^PS(57.7,+PSJLWD,1,+$O(^PS(57.7,"AWRT",+PSJLWD,PSJLRB,0)),0)),U),1:""),PSJWGN=$P($G(^PS(57.5,+$O(^PS(57.5,"AB",+PSJLWD,0)),0)),U)
12 K PSJLAT,ON55 D @$S(ON["V":"GT55^PSIVORFB",1:"GT531^PSIVORFA(DFN,ON)") S (MSG,PSJRPH,PSJLDT,PSJLR)="" S:ON["V" X=$G(^PS(55,DFN,"IV",+ON,7)),PSJLDT=+X,PSJLR=$P(X,U,2)
13 I ON["P",(P("OPI")=""),$O(^PS(53.1,+ON,12,0)) F X=0:0 S X=$O(^PS(53.1,+ON,12,X)) Q:'X!($L(P("OPI"))>180) S P("OPI")=P("OPI")_" "_$G(^(X,0))
14 S PSJLAT=P(11),PSGLST=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I PSGLST'="O" S PSGLST=$S(P(9)["PRN":"P",1:"C")
15 S:ON["P" PSGLST=""
16 F X="LOG",2,3 S:P(X) P(X)=$$ENDTC1^PSGMI(P(X))
17 D RPHINIT^PSGMIV(.PSJRPH)
18 S X=P(17),(PSJLAT(1),PSJLAT(2),PSJLAT(4),PSJLAT(5))=$S(X="D"!(X="E"):"****",1:""),PSJLAT(3)=$S(X="D":"DC'D",X="E":"EX'D",1:""),PSJLAT(0)=$S(X="D":0,X="E":0,1:$L(PSJLAT,"-"))
19 I PSJLAT(0) D
20 .F X=1:1:5 S PSJLAT(X)=""
21 .I PSJLAT(0)=1 S PSJLAT(3)=$P(PSJLAT,"-") Q
22 .I PSJLAT(0)=2 S PSJLAT(1)=$P(PSJLAT,"-"),PSJLAT(5)=$P(PSJLAT,"-",2) Q
23 .I PSJLAT(0)=3 S PSJLAT(1)=$P(PSJLAT,"-"),PSJLAT(3)=$P(PSJLAT,"-",2),PSJLAT(5)=$P(PSJLAT,"-",3) Q
24 .F X=1:1:PSJLAT(0) S PSJLAT(X)=$P(PSJLAT,"-",X)
25 ;
26ENP ; Print MAR label for IV order.
27 S PSGLRN=$S(ON["P":$G(^PS(53.1,+ON,4)),1:$G(^PS(55,DFN,"IV",+ON,4)))
28 I $G(DFN),$G(ON) N PSGLREN S PSGLREN=+$$LASTREN^PSJLMPRI(DFN,ON)
29 N PSGLRNDT S PSGLRNDT=$P(PSGLRN,"^",2),PSGLRN=+PSGLRN I PSGLRNDT,$G(PSGLREN) I $G(PSGLREN)>PSGLRNDT S PSGLRN=0
30 I ON["P",P(2)="",+PSGLRN S X="P E N D I N G"
31 E S X=$S(P(2)]"":$E(P(2),1,5)_$E(P(2),9,14),1:" ")_" |"_P(3)
32 W $C(13),?1,$E(P("LOG"),1,5)," |",X,?36,"(",$E(VADM(1),1),$E(VADM(2),6,9),")",?42,"|",$G(PSJLAT(1)),?52,VADM(1),?88,$J($S(PSJLRB]"":PSJLRB,1:"*NF*"),12)
33 S:'+PSGLRN PSGLRN="_____"
34 I +PSGLRN,$D(^VA(200,+PSGLRN,0))#2 S X=^(0),X=$S($P(X,"^",2)]"":$P(X,"^",2),1:$P(X,"^")),PSGLRN=$S(X'[",":X,1:$E(X,$F(X,","))_$E(X))
35 S PSJCNT=2,X=0,MSG="",PSJCONT="See next label for continuation"
36 NEW NAME
37 W ! F X=0:0 S X=$O(DRG("AD",X)) Q:'X D NAME^PSIVUTL(DRG("AD",X),47,.NAME,1) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y W ?1,NAME(Y) D NXTLNE(1) S:$P($G(^PS(52.6,+DRG("AD",+X),0)),U,9)]"" MSG=MSG_$P($G(^(0)),U,9)_" "
38 ;*W:$G(DRG("SOL",0)) ?1,"in " F X=0:0 S X=$O(DRG("SOL",X)) Q:'X D NAME^PSIVUTL(DRG("SOL",X),47,.NAME,1) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y W ?4,NAME(Y) D NXTLNE(1)
39 NEW PSJPRT2
40 W:$G(DRG("SOL",0)) ?1,"in " F X=0:0 S X=$O(DRG("SOL",X)) Q:'X D NAME^PSIVUTL(DRG("SOL",X),47,.NAME,1) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y D
41 . W ?4,NAME(Y) D NXTLNE(1)
42 . S PSJPRT2=$P(^PS(52.7,+DRG("SOL",X),0),U,4) I PSJPRT2]"" W !?7,PSJPRT2 D NXTLNE(1)
43 I MSG]"" S P("OPI")=MSG_P("OPI") S:$L($P(P("OPI"),"^"))>180 $P(P("OPI"),"^")=$E($P(P("OPI"),"^"),1,177)_"..."
44 W ?1,$P(P("MR"),U,2)," ",P(9)," ",P(8) I P("OPI")]""!$D(PSJLAT(PSJCNT+1))!(P(4)="C") D NXTLNE($S($L($P(P("OPI"),"^"))>22:1,P(4)'="C":0,1:$L($P(P("OPI"),"^"))))
45 I P(4)="C" W "*CAUTION-CHEMOTHERAPY*" D:$L($P(P("OPI"),"^")) NXTLNE($L($P(P("OPI"),"^"))>22)
46 I P("OPI")]"" W ?1,"" F Y=1:1:$L($P(P("OPI"),"^")," ") D
47 .S Y1=$P($P(P("OPI"),"^")," ",Y) I $X+$L(Y1)>42 D NXTLNE($L($P($P(P("OPI"),"^")," ",Y))>23) W ?1
48 .W Y1," "
49 D:$X>24 NXTLNE(1)
50 I $D(PSJLAT(PSJCNT+1)) F Q:'$D(PSJLAT(PSJCNT+1)) D
51 .I PSJCNT#5=0 W ?1,PSJCONT D NXTLNE(2) W ?1 Q
52 .D NXTLNE($D(PSJLAT(PSJCNT+2)))
53 I PSJCNT#5>0 F Q:PSJCNT#5=0 D NXTLNE(0)
54 W ?24,"RPH:",PSJRPH,?33," RN:",PSGLRN D NXTLNE($D(PSJLAT(PSJCNT+1))) W !
55 ;* W ?24,"RPH:",$S(PSJRPH]"":PSJRPH,1:"_____"),?33," RN:_____" D NXTLNE($D(PSJLAT(PSJCNT+1))) W !
56DONE ;
57 K DRG,MSG,NL,ON55,PSJTM,P,PSJLAT,PSJRPH,PSJACNWP,PSJCNT,PSJLDT,PSJLR,PSJTM,PSJWGN,X,Y,Y1
58 Q
59NXTLNE(NL) ; Print info to right of drug (x=line number,NL=new label)
60 N Y
61 W:PSJCNT=2 ?42,PSGLST W ?43,"|",$G(PSJLAT(PSJCNT)) I PSJCNT=2 W ?52,$P(VADM(2),U,2),?70,$E($$ENDTC^PSGMI(+VADM(3)),1,8)," (",VADM(4),")",?85,$J($S(PSJTM]"":PSJTM,1:"NOT FOUND"),15)
62 I PSJCNT=3 W ?52,$S(VADM(5)]"":$P(VADM(5),U,2),1:"____"),?65,"DX: ",VAIN(9)
63 I PSJCNT=4,PSJLDT S Y=PSJLR D
64 .W ?52,$$ENDTC^PSGMI(PSJLDT)
65 .W ?77,$S(Y="N":"NEW ",Y="R":"RENEWAL ",1:""),"ORDER ",$S(Y="AD":"AUTO-DC'ED",Y="N":"",Y="E":"EDITED",Y="DE":"DC'ED (EDIT)",Y["D":"DISCONTINUED",Y="H1":"ON HOLD",Y="H0":"OFF OF HOLD",Y="ARI":"AUTO-REINSTATED",Y="RI":"REINSTATED",1:"")
66 I PSJCNT=5 W ?52,$S(PSJWGN]"":$E(PSJWGN,1,21),1:"NOT FOUND"),?79,$J($S($P(PSJLWD,U,2)]"":$P(PSJLWD,U,2),1:"NOT FOUND"),21)
67 W !,?1 S PSJCNT=PSJCNT+1 I NL=2 W !,?1 S NL=0
68 I PSJCNT#5=0,NL W ?1,PSJCONT D NXTLNE(2)
69 Q
Note: See TracBrowser for help on using the repository browser.