PSGMMIVC ;BIR/MV-PRT MULT DAYS MAR C ORDERS(IV) ;16 Mar 99 / 2:10 PM
;;5.0;INPATIENT MEDICATIONS;**20,21,28,31,35,67,58,110,267**;16 DEC 97;Build 158
;
; Reference to ^PS(52.7 supported by DBIA #2173.
; Reference to ^PS(55 supported by DBIA #2191.
;
PRT ;*** Print IV orders.
K P,DRG,PSGLRN,PSGMARTS,PSGMARGD,PSGLFFD,TS N ON55,PSJLABEL S TS=1,PSGMARGD="",PSJLABEL=1
S ON=$P(DAO,U,2),DFN=$P(PN,U,2) D:$P(DAO,U,2)["V" GT55^PSIVORFB D:$P(DAO,U,2)["P" GT531^PSIVORFA(DFN,ON) D:P(9)]"" OS S PSGLSSD=P(2),PSGLFFD=P(3)
I $G(P("DTYP"))'=1 K P(11)
F X="LOG",2,3 S:P(X) P(X)=$$ENDTC1^PSGMI(P(X))
D INITOPI
S PSGST=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I PSGST'="O" S PSGST=$S(P(9)["PRN":"P",1:"C")
I PSGST="O",(P(2)="") S PSGST=""
NEW NAMENEED,NEED,X S NAMENEED=0
D LNNEED^PSGMIV,PRTIV
Q
;
OS ; order record set
S FD=P(3),PSGOES="",X=P(9),SD=P(2) D EN^PSGS0 S T=PSGS0XT
S QQ="" I PST["C" D DTS^PSGMMAR0(P(9)) S SD=$P(SD,"."),QQ="" F X=0:0 S X=$O(PSGD(X)) Q:'X S QQ=QQ_$S(X<SD:"",X>FD:"",'S:$P(PSGD(X),U),$D(S(X)):$P(PSGD(X),U),1:"")
I T="D",P(11)="" S P(11)=$E($P(P(2),".",2)_"0000",1,4)
S PSGMARTS=P(11),PSGMARGD=QQ
K TS D TS^PSGMAR3(P(11))
Q
;
PRTIV ;*** Print IV order on MAR
I PSGMAROC,(PSGMAROC+LN)>6 D BOT^PSGMMAR2,HEADER^PSGMMAR2
S PSGMAROC=PSGMAROC+1 W !?6,"|",?19,"|",?48,"|",$G(TS(1)) D CELL(1,0)
W !,$E(P("LOG"),1,5)," |"
W:ON["V" $E(P(2),1,5)_$E(P(2),9,14)," |",P(3)
W:ON["P" "P E N D I N G"
W ?39,"("_$E(PSGP(0))_$E(PSSN,8,12)_")"
W ?48,"|",$G(TS(2)) D CELL(2,0) S L=3
NEW NAME
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 !,NAME(Y) W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
I '$G(DRG("AD",0)) D
.W !
.W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
W:$G(DRG("SOL",0)) !,"in "
NEW PSJPRT2
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
. W:(Y>1!(X>1)) ! W ?4,NAME(Y) W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
. S PSJPRT2=$P(^PS(52.7,+DRG("SOL",X),0),U,4) I PSJPRT2]"" W !?7,PSJPRT2 W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
W !,$P(P("MR"),U,2)," ",P(9)," ",P(8) W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) I L>5 S PSJTMPL=L\6,PSJDIV=PSJTMPL+4 I L>PSJDIV,(L#PSJDIV>1) W ! ;I L>5,(L#5>1) W !
I '$G(DRG("SOL",0)) S L=L+1 W !,?48,"|",$G(TS(L)) D CELL(L,'(L#6))
I P(4)="C",'(L#5),P("OPI")="" D
. D L(1)
. W !,"*CAUTION-CHEMOTHERAPY*",?48,"|",$G(TS(L))
. D CELL(L,'(L#6)) W ! ;S L=L+1
E I P(4)="C" D
. D L(1)
. W:L#7=0 !
. W "*CAUTION-CHEMOTHERAPY*",?48,"|",$G(TS(L))
. D CELL(L,'(L#6))
. I (L+1)#6'=0 W !
I (L#5)=0,($L($P(P("OPI"),"^"))<29),(TS<7) S L=L+1
E D L(1)
W:P("OPI")=""&(TS>6) !
I P("OPI")'="",'$$OPI^PSGMIV(PSGP,ON55) D
. I L#7=0 W !
. I L#5=1 W !
. N PSJTMPX S PSJTMPX=0
. F Y=1:1:$L($P(P("OPI"),"^")," ") S Y1=$P($P(P("OPI"),"^")," ",Y) D
.. I $L(Y1)>47 W $E(Y1,1,47)
.. I (PSJTMPX+$L(Y1))>47 W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)),L(1) S PSJTMPX=0 W !
.. I $L(Y1)>47 W $E(Y1,48,$L(Y1)) S PSJTMPX=$L($E(Y1,48,$L(Y1)))
.. E W Y1," " S PSJTMPX=PSJTMPX+$L(Y1)+1
N PSGIVFL I '$O(DRG("AD",0))!'$O(DRG("SOL",0)) S PSGIVFL=1
I L>TS,(L#6) W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) S L=L+1
I (TS-1)>L W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D
. F L=L+1:1:TS-1 D L(0) W !?48,"|",$G(TS(L)) D CELL(L,'(L#6))
. S L=L+1
F Q:'(L#6) W !?48,"|",$G(TS(L)) D CELL(L,'(L#6)) S L=L+1
I '(L#6),(P("OPI")="") W !
I P("OPI")]"",(L>6) W !
W ?29,"RPH: ",PSGLRPH,?38,"RN: ",PSGLRN,?48,"|",$G(TS(L)) D CELL(L,'(L#6)) W:PSGMAROC<6 !?7,LN2
Q
;
L(X) ;***Check to see if a new block if needed.
S L=L+X
I L#6=0,PSGMAROC<6 D
. W !,"See next label for continuation",?48,"|",$G(TS(L)) D CELL(L,'(L#6))
. W:PSGMAROC<6 !?7,LN2,$C(13) S $X=0 S PSGMAROC=PSGMAROC+1,L=L+1 D
. . I LN>6,(PSGMAROC>5) S MSG1="*** CONTINUE ON NEXT PAGE ***" D BOT^PSGMMAR2,HEADER^PSGMMAR2 S PSGMAROC=1
Q
LN(L) ;*** Print lines within block.
N X S X=$S(L#6:LN4,1:LN7)
Q X
CELL(X,X1) ;
I ON["P",(X=6) NEW PSGLFFD,PSGMARGD S P(9)="",PSGLFFD="9999999",PSGMARGD="" W ?55 D ASTERS^PSGMMAR2 Q
I TS=1,'$G(P(11)),(X=6) W ?55 D ASTERS^PSGMMAR2 Q
I TS=1,'$G(P(11)) W ?55,$$LN(X) Q
D CELL^PSGMMAR2(X,X1)
Q
INITOPI ;* Set nurse's initial and the other print info.
D RPHINIT^PSGMIV(.PSGLRPH)
S PSGLRN="_____"
I ON["V" N ND4 S ND4=$G(^PS(55,DFN,"IV",+ON,4))
I $G(ND4) D
.I $G(DFN),$G(ON) N PSGLREN S PSGLREN=+$$LASTREN^PSJLMPRI(DFN,ON) D
..N PSGLRNDT S PSGLRNDT=$P(ND4,"^",2),ND4=+ND4 I PSGLRNDT,$G(PSGLREN) I $G(PSGLREN)>PSGLRNDT S ND4=0
.I ND4 D NAME(+ND4,"",.PSGLRN)
I ON["P" D
. I P("OPI")="",$O(^PS(53.1,ON,12,0)) S X=0 F S X=$O(^PS(53.1,ON,12,X)) Q:'X S Z=$G(^(X,0)),Y=$L(P("OPI")) S:Y+$L(Z)'>179 P("OPI")=P("OPI")_Z_" " I Y+$L(Z)>179 S P("OPI")="SEE PROVIDER COMMENTS"
. S PSGST=""
. D NAME(+$G(^PS(53.1,+ON,4)),"",.PSGLRN)
Q
NAME(X,NAME,INIT) ;Lookup in ^VA(200.
;X = IEN in ^VA(200
;NAME = Return the name in 200
;INIT = Return the initial
NEW DIC,Y
S DIC="^VA(200,",DIC(0)="NZ" D ^DIC
S NAME=$G(Y(0,0))
S INIT=$P($G(Y(0)),U,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGMMIVC 5183 printed Apr 09, 2024@21:05:25 Page 2
PSGMMIVC ;BIR/MV-PRT MULT DAYS MAR C ORDERS(IV) ;16 Mar 99 / 2:10 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**20,21,28,31,35,67,58,110,267**;16 DEC 97;Build 158
+2 ;
+3 ; Reference to ^PS(52.7 supported by DBIA #2173.
+4 ; Reference to ^PS(55 supported by DBIA #2191.
+5 ;
PRT ;*** Print IV orders.
+1 KILL P,DRG,PSGLRN,PSGMARTS,PSGMARGD,PSGLFFD,TS
NEW ON55,PSJLABEL
SET TS=1
SET PSGMARGD=""
SET PSJLABEL=1
+2 SET ON=$PIECE(DAO,U,2)
SET DFN=$PIECE(PN,U,2)
if $PIECE(DAO,U,2)["V"
DO GT55^PSIVORFB
if $PIECE(DAO,U,2)["P"
DO GT531^PSIVORFA(DFN,ON)
if P(9)]""
DO OS
SET PSGLSSD=P(2)
SET PSGLFFD=P(3)
+3 IF $GET(P("DTYP"))'=1
KILL P(11)
+4 FOR X="LOG",2,3
if P(X)
SET P(X)=$$ENDTC1^PSGMI(P(X))
+5 DO INITOPI
+6 SET PSGST=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3))
IF PSGST'="O"
SET PSGST=$SELECT(P(9)["PRN":"P",1:"C")
+7 IF PSGST="O"
IF (P(2)="")
SET PSGST=""
+8 NEW NAMENEED,NEED,X
SET NAMENEED=0
+9 DO LNNEED^PSGMIV
DO PRTIV
+10 QUIT
+11 ;
OS ; order record set
+1 SET FD=P(3)
SET PSGOES=""
SET X=P(9)
SET SD=P(2)
DO EN^PSGS0
SET T=PSGS0XT
+2 SET QQ=""
IF PST["C"
DO DTS^PSGMMAR0(P(9))
SET SD=$PIECE(SD,".")
SET QQ=""
FOR X=0:0
SET X=$ORDER(PSGD(X))
if 'X
QUIT
SET QQ=QQ_$SELECT(X<SD:"",X>FD:"",'S:$PIECE(PSGD(X),U),$DATA(S(X)):$PIECE(PSGD(X),U),1:"")
+3 IF T="D"
IF P(11)=""
SET P(11)=$EXTRACT($PIECE(P(2),".",2)_"0000",1,4)
+4 SET PSGMARTS=P(11)
SET PSGMARGD=QQ
+5 KILL TS
DO TS^PSGMAR3(P(11))
+6 QUIT
+7 ;
PRTIV ;*** Print IV order on MAR
+1 IF PSGMAROC
IF (PSGMAROC+LN)>6
DO BOT^PSGMMAR2
DO HEADER^PSGMMAR2
+2 SET PSGMAROC=PSGMAROC+1
WRITE !?6,"|",?19,"|",?48,"|",$GET(TS(1))
DO CELL(1,0)
+3 WRITE !,$EXTRACT(P("LOG"),1,5)," |"
+4 if ON["V"
WRITE $EXTRACT(P(2),1,5)_$EXTRACT(P(2),9,14)," |",P(3)
+5 if ON["P"
WRITE "P E N D I N G"
+6 WRITE ?39,"("_$EXTRACT(PSGP(0))_$EXTRACT(PSSN,8,12)_")"
+7 WRITE ?48,"|",$GET(TS(2))
DO CELL(2,0)
SET L=3
+8 NEW NAME
+9 FOR X=0:0
SET X=$ORDER(DRG("AD",X))
if 'X
QUIT
DO NAME^PSIVUTL(DRG("AD",X),47,.NAME,1)
FOR Y=0:0
SET Y=$ORDER(NAME(Y))
if 'Y
QUIT
WRITE !,NAME(Y)
if L=3
WRITE ?47,PSGST
WRITE ?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
DO L(1)
+10 IF '$GET(DRG("AD",0))
Begin DoDot:1
+11 WRITE !
+12 if L=3
WRITE ?47,PSGST
WRITE ?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
DO L(1)
End DoDot:1
+13 if $GET(DRG("SOL",0))
WRITE !,"in "
+14 NEW PSJPRT2
+15 FOR X=0:0
SET X=$ORDER(DRG("SOL",X))
if 'X
QUIT
DO NAME^PSIVUTL(DRG("SOL",X),47,.NAME,1)
FOR Y=0:0
SET Y=$ORDER(NAME(Y))
if 'Y
QUIT
Begin DoDot:1
+16 if (Y>1!(X>1))
WRITE !
WRITE ?4,NAME(Y)
if L=3
WRITE ?47,PSGST
WRITE ?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
DO L(1)
+17 SET PSJPRT2=$PIECE(^PS(52.7,+DRG("SOL",X),0),U,4)
IF PSJPRT2]""
WRITE !?7,PSJPRT2
if L=3
WRITE ?47,PSGST
WRITE ?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
DO L(1)
End DoDot:1
+18 ;I L>5,(L#5>1) W !
WRITE !,$PIECE(P("MR"),U,2)," ",P(9)," ",P(8)
WRITE ?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
IF L>5
SET PSJTMPL=L\6
SET PSJDIV=PSJTMPL+4
IF L>PSJDIV
IF (L#PSJDIV>1)
WRITE !
+19 IF '$GET(DRG("SOL",0))
SET L=L+1
WRITE !,?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
+20 IF P(4)="C"
IF '(L#5)
IF P("OPI")=""
Begin DoDot:1
+21 DO L(1)
+22 WRITE !,"*CAUTION-CHEMOTHERAPY*",?48,"|",$GET(TS(L))
+23 ;S L=L+1
DO CELL(L,'(L#6))
WRITE !
End DoDot:1
+24 IF '$TEST
IF P(4)="C"
Begin DoDot:1
+25 DO L(1)
+26 if L#7=0
WRITE !
+27 WRITE "*CAUTION-CHEMOTHERAPY*",?48,"|",$GET(TS(L))
+28 DO CELL(L,'(L#6))
+29 IF (L+1)#6'=0
WRITE !
End DoDot:1
+30 IF (L#5)=0
IF ($LENGTH($PIECE(P("OPI"),"^"))<29)
IF (TS<7)
SET L=L+1
+31 IF '$TEST
DO L(1)
+32 if P("OPI")=""&(TS>6)
WRITE !
+33 IF P("OPI")'=""
IF '$$OPI^PSGMIV(PSGP,ON55)
Begin DoDot:1
+34 IF L#7=0
WRITE !
+35 IF L#5=1
WRITE !
+36 NEW PSJTMPX
SET PSJTMPX=0
+37 FOR Y=1:1:$LENGTH($PIECE(P("OPI"),"^")," ")
SET Y1=$PIECE($PIECE(P("OPI"),"^")," ",Y)
Begin DoDot:2
+38 IF $LENGTH(Y1)>47
WRITE $EXTRACT(Y1,1,47)
+39 IF (PSJTMPX+$LENGTH(Y1))>47
WRITE ?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
DO L(1)
SET PSJTMPX=0
WRITE !
+40 IF $LENGTH(Y1)>47
WRITE $EXTRACT(Y1,48,$LENGTH(Y1))
SET PSJTMPX=$LENGTH($EXTRACT(Y1,48,$LENGTH(Y1)))
+41 IF '$TEST
WRITE Y1," "
SET PSJTMPX=PSJTMPX+$LENGTH(Y1)+1
End DoDot:2
End DoDot:1
+42 NEW PSGIVFL
IF '$ORDER(DRG("AD",0))!'$ORDER(DRG("SOL",0))
SET PSGIVFL=1
+43 IF L>TS
IF (L#6)
WRITE ?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
SET L=L+1
+44 IF (TS-1)>L
WRITE ?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
Begin DoDot:1
+45 FOR L=L+1:1:TS-1
DO L(0)
WRITE !?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
+46 SET L=L+1
End DoDot:1
+47 FOR
if '(L#6)
QUIT
WRITE !?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
SET L=L+1
+48 IF '(L#6)
IF (P("OPI")="")
WRITE !
+49 IF P("OPI")]""
IF (L>6)
WRITE !
+50 WRITE ?29,"RPH: ",PSGLRPH,?38,"RN: ",PSGLRN,?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
if PSGMAROC<6
WRITE !?7,LN2
+51 QUIT
+52 ;
L(X) ;***Check to see if a new block if needed.
+1 SET L=L+X
+2 IF L#6=0
IF PSGMAROC<6
Begin DoDot:1
+3 WRITE !,"See next label for continuation",?48,"|",$GET(TS(L))
DO CELL(L,'(L#6))
+4 if PSGMAROC<6
WRITE !?7,LN2,$CHAR(13)
SET $X=0
SET PSGMAROC=PSGMAROC+1
SET L=L+1
Begin DoDot:2
+5 IF LN>6
IF (PSGMAROC>5)
SET MSG1="*** CONTINUE ON NEXT PAGE ***"
DO BOT^PSGMMAR2
DO HEADER^PSGMMAR2
SET PSGMAROC=1
End DoDot:2
End DoDot:1
+6 QUIT
LN(L) ;*** Print lines within block.
+1 NEW X
SET X=$SELECT(L#6:LN4,1:LN7)
+2 QUIT X
CELL(X,X1) ;
+1 IF ON["P"
IF (X=6)
NEW PSGLFFD,PSGMARGD
SET P(9)=""
SET PSGLFFD="9999999"
SET PSGMARGD=""
WRITE ?55
DO ASTERS^PSGMMAR2
QUIT
+2 IF TS=1
IF '$GET(P(11))
IF (X=6)
WRITE ?55
DO ASTERS^PSGMMAR2
QUIT
+3 IF TS=1
IF '$GET(P(11))
WRITE ?55,$$LN(X)
QUIT
+4 DO CELL^PSGMMAR2(X,X1)
+5 QUIT
INITOPI ;* Set nurse's initial and the other print info.
+1 DO RPHINIT^PSGMIV(.PSGLRPH)
+2 SET PSGLRN="_____"
+3 IF ON["V"
NEW ND4
SET ND4=$GET(^PS(55,DFN,"IV",+ON,4))
+4 IF $GET(ND4)
Begin DoDot:1
+5 IF $GET(DFN)
IF $GET(ON)
NEW PSGLREN
SET PSGLREN=+$$LASTREN^PSJLMPRI(DFN,ON)
Begin DoDot:2
+6 NEW PSGLRNDT
SET PSGLRNDT=$PIECE(ND4,"^",2)
SET ND4=+ND4
IF PSGLRNDT
IF $GET(PSGLREN)
IF $GET(PSGLREN)>PSGLRNDT
SET ND4=0
End DoDot:2
+7 IF ND4
DO NAME(+ND4,"",.PSGLRN)
End DoDot:1
+8 IF ON["P"
Begin DoDot:1
+9 IF P("OPI")=""
IF $ORDER(^PS(53.1,ON,12,0))
SET X=0
FOR
SET X=$ORDER(^PS(53.1,ON,12,X))
if 'X
QUIT
SET Z=$GET(^(X,0))
SET Y=$LENGTH(P("OPI"))
if Y+$LENGTH(Z)'>179
SET P("OPI")=P("OPI")_Z_" "
IF Y+$LENGTH(Z)>179
SET P("OPI")="SEE PROVIDER COMMENTS"
+10 SET PSGST=""
+11 DO NAME(+$GET(^PS(53.1,+ON,4)),"",.PSGLRN)
End DoDot:1
+12 QUIT
NAME(X,NAME,INIT) ;Lookup in ^VA(200.
+1 ;X = IEN in ^VA(200
+2 ;NAME = Return the name in 200
+3 ;INIT = Return the initial
+4 NEW DIC,Y
+5 SET DIC="^VA(200,"
SET DIC(0)="NZ"
DO ^DIC
+6 SET NAME=$GET(Y(0,0))
+7 SET INIT=$PIECE($GET(Y(0)),U,2)
+8 QUIT
