PSJORMA2 ;BIR/MV-COLLECT DATA FOR ACTIVE IV AND FLUID PENDINGS ; 3/23/10 2:42pm
;;5.0;INPATIENT MEDICATIONS ;**2,15,21,26,58,237,275**;16 DEC 97;Build 157
;
; References to ^PS(52.7 supported by DBIA #2173
; References to ^PS(55 supported by DBIA #2191
; Reference to SETSTR^VALM1 supported by DBIA #10116
;
PRT ;Get IV nodes.
K P,DRG,PSGLRN,PSGMARTS,PSGMARGD,PSGLFFD,TS N ON55 S TS=1,PSGMARGD=""
I ON["V" D
.I '$G(DUZ) N DUZ S DUZ=$J
.I '$G(PSJSYSP) N PSJSYSP S PSJSYSP=$J
.D GT55^PSIVORFB
I ON["P" D GT531^PSIVORFA(DFN,ON,1)
I $G(ACT)="NW" D
.S P("OLDON")=$S(ON["P":$P($G(^PS(53.1,+ON,0)),U,25),1:$P($G(^PS(55,DFN,"IV",+ON,2)),U,5))
.I $G(P("OLDON"))]"" S PSJROC=$S(P("OLDON")["V":$P(^PS(55,DFN,"IV",+P("OLDON"),2),U,8),1:$P(^PS(53.1,+P("OLDON"),0),U,27)),PSJF=$S(P("OLDON")["V":"^PS(55,"_DFN_",""IV"","_+P("OLDON"),1:"^PS(53.1,"_+P("OLDON")) D
..S $P(@(PSJF_",7)"),U,1,2)=PSJLDT_"^"_$S(PSJROC="R":"R",1:"DE")
S PSJF=$S(ON["V":"^PS(55,"_DFN_",""IV"","_+ON,1:"^PS(53.1,"_+ON)
I $G(ACT)]""&($G(ACT)'="NW") S $P(@(PSJF_",7)"),U,1,2)=PSJLDT_"^"_$S(ACT="DC":"D",ACT="HD":"H1",1:"H0")
S PSGLR=$S(ON["P":$P($G(^PS(53.1,+ON,7)),U,2),1:$P($G(^PS(55,DFN,"IV",+ON,7)),U,2))
S (PST,PSGST)=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I PST="" S (PST,PSGST)=$S(P(9)["PRN":"P",P(2)=P(3):"O",1:"C")
D:P(9)]"" OS S PSGLSD=P(2),PSGLFD=P(3)
F X="LOG",2 S:P(X) P(X)=$$ENDTC1^PSGMI(P(X))
D INITOPI
I PSGST="O",(P(2)="") S PSGST=""
NEW NAMENEED,NEED,X S NAMENEED=0
;D LNNEED^PSGMIV,PRTIV
D PRTIV
Q
;
OS ; Define admin times.
;* S FD=P(3),PSGOES="",X=P(9),SD=P(2) D EN^PSGS0 S T=PSGS0XT
S (FD,PSGMARFD)=P(3),PSGOES="",X=P(9),(SD,PSGMARSD)=P(2) D EN^PSGS0 S T=PSGS0XT
S QQ="" I PSGST["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:"")
K PSGMARFD,PSGMARSD
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 ; Set up order info on IV label.
S MARLB(1)=$E(P("LOG"),1,5)_" |"
I ON["P",+$G(^PS(53.1,+ON,4)) S MARLB(1)=MARLB(1)_"P E N D I N G"
E S MARLB(1)=MARLB(1)_$E(P(2),1,5)_$E(P(2),9,14),X=$S(ON["P":"",P(3)=1:"********",1:$$ENDTC1^PSGMI(P(3))),MARLB(1)=$$SETSTR^VALM1(" |"_X,MARLB(1),19,16)
S MARLB(1)=$$SETSTR^VALM1("("_PSGLBS5_")",MARLB(1),36,7)
NEW NAME S L=2
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 D
. S MARLB(L)=NAME(Y) S:L=2 MARLB(L)=$$SETSTR^VALM1(PSGST,MARLB(L),42,1) D L(1)
S:$G(DRG("SOL",0)) MARLB(L)="in " NEW PSJPRT2
F X=0:0 S X=$O(DRG("SOL",X)) Q:'X D NAME^PSIVUTL(DRG("SOL",X),47,.NAME,1) D
. F Y=0:0 S Y=$O(NAME(Y)) Q:'Y S:(Y>1) L=L+1 S MARLB(L)=$$SETSTR^VALM1(NAME(Y),$G(MARLB(L)),4,$L(NAME(Y))) D L(1)
. S PSJPRT2=$P(^PS(52.7,+DRG("SOL",X),0),U,4) I PSJPRT2]"" S:(Y>1) L=L+1 S MARLB(L)=" "_PSJPRT2 D L(1)
S MARLB(L)=$P(P("MR"),U,2)_" "_P(9)_" "_P(8)
;I P(4)="C",'(L#4),P("OPI")="" S L=L+1,MARLB(L)=$G(MARLB(L))_"*CAUTION-CHEMOTHERAPY*" S L=L+1 Q
I P(4)="C",'(L#4),P("OPI")="" D L(1) S MARLB(L)=$G(MARLB(L))_"*CAUTION-CHEMOTHERAPY*" D L(1)
I P(4)'="C",(P("OPI")="") S L=L+1
I P("OPI")'="" D L(1) D
. F Y=1:1:$L($P(P("OPI"),"^")," ") D:$L($P($P(P("OPI"),"^")," ",Y)_" ")+$L($G(MARLB(L)))>42 L(1) S MARLB(L)=$G(MARLB(L))_$P($P(P("OPI"),"^")," ",Y)_" " ;**PSJ*5.0*237-Prevent sentence cutoff
. S L=L+1
I (L#5)>0 S X=0 F Q:X D
. D L(0) S MARLB(L)="",L=L+1
. I TS,(L>TS),'(L#5) S X=1 Q
. I TS=0,'(L#5) S X=1 Q
S MARLB(L)=$$SETSTR^VALM1("RPH: "_PSGLRPH,$G(MARLB(L)),23,10)
S MARLB(L)=$$SETSTR^VALM1("RN: "_PSGLRN,$G(MARLB(L)),33,9)
Q
;
L(X) ;***Check to see if a new block if needed.
S L=L+X
I L#5=0 S MARLB(L)="See next label for continuation",L=L+1
Q
INITOPI ;* Set nurse's initial and the other print info.
D RPHINIT^PSGMIV(.PSGLRPH)
S PSGLRN="_____"
S:ON["P" PSGLRN=+$G(^PS(53.1,+ON,4)) S:ON["V" PSGLRN=+$G(^PS(55,DFN,"IV",+ON,4))
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))
S:$G(PSGLRN)=0 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=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJORMA2 4404 printed Sep 23, 2025@19:44:26 Page 2
PSJORMA2 ;BIR/MV-COLLECT DATA FOR ACTIVE IV AND FLUID PENDINGS ; 3/23/10 2:42pm
+1 ;;5.0;INPATIENT MEDICATIONS ;**2,15,21,26,58,237,275**;16 DEC 97;Build 157
+2 ;
+3 ; References to ^PS(52.7 supported by DBIA #2173
+4 ; References to ^PS(55 supported by DBIA #2191
+5 ; Reference to SETSTR^VALM1 supported by DBIA #10116
+6 ;
PRT ;Get IV nodes.
+1 KILL P,DRG,PSGLRN,PSGMARTS,PSGMARGD,PSGLFFD,TS
NEW ON55
SET TS=1
SET PSGMARGD=""
+2 IF ON["V"
Begin DoDot:1
+3 IF '$GET(DUZ)
NEW DUZ
SET DUZ=$JOB
+4 IF '$GET(PSJSYSP)
NEW PSJSYSP
SET PSJSYSP=$JOB
+5 DO GT55^PSIVORFB
End DoDot:1
+6 IF ON["P"
DO GT531^PSIVORFA(DFN,ON,1)
+7 IF $GET(ACT)="NW"
Begin DoDot:1
+8 SET P("OLDON")=$SELECT(ON["P":$PIECE($GET(^PS(53.1,+ON,0)),U,25),1:$PIECE($GET(^PS(55,DFN,"IV",+ON,2)),U,5))
+9 IF $GET(P("OLDON"))]""
SET PSJROC=$SELECT(P("OLDON")["V":$PIECE(^PS(55,DFN,"IV",+P("OLDON"),2),U,8),1:$PIECE(^PS(53.1,+P("OLDON"),0),U,27))
SET PSJF=$SELECT(P("OLDON")["V":"^PS(55,"_DFN_",""IV"","_+P("OLDON"),1:"^PS(53.1,"_+P("OLDON"))
Begin DoDot:2
+10 SET $PIECE(@(PSJF_",7)"),U,1,2)=PSJLDT_"^"_$SELECT(PSJROC="R":"R",1:"DE")
End DoDot:2
End DoDot:1
+11 SET PSJF=$SELECT(ON["V":"^PS(55,"_DFN_",""IV"","_+ON,1:"^PS(53.1,"_+ON)
+12 IF $GET(ACT)]""&($GET(ACT)'="NW")
SET $PIECE(@(PSJF_",7)"),U,1,2)=PSJLDT_"^"_$SELECT(ACT="DC":"D",ACT="HD":"H1",1:"H0")
+13 SET PSGLR=$SELECT(ON["P":$PIECE($GET(^PS(53.1,+ON,7)),U,2),1:$PIECE($GET(^PS(55,DFN,"IV",+ON,7)),U,2))
+14 SET (PST,PSGST)=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3))
IF PST=""
SET (PST,PSGST)=$SELECT(P(9)["PRN":"P",P(2)=P(3):"O",1:"C")
+15 if P(9)]""
DO OS
SET PSGLSD=P(2)
SET PSGLFD=P(3)
+16 FOR X="LOG",2
if P(X)
SET P(X)=$$ENDTC1^PSGMI(P(X))
+17 DO INITOPI
+18 IF PSGST="O"
IF (P(2)="")
SET PSGST=""
+19 NEW NAMENEED,NEED,X
SET NAMENEED=0
+20 ;D LNNEED^PSGMIV,PRTIV
+21 DO PRTIV
+22 QUIT
+23 ;
OS ; Define admin times.
+1 ;* S FD=P(3),PSGOES="",X=P(9),SD=P(2) D EN^PSGS0 S T=PSGS0XT
+2 SET (FD,PSGMARFD)=P(3)
SET PSGOES=""
SET X=P(9)
SET (SD,PSGMARSD)=P(2)
DO EN^PSGS0
SET T=PSGS0XT
+3 SET QQ=""
IF PSGST["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:"")
+4 KILL PSGMARFD,PSGMARSD
+5 IF T="D"
IF P(11)=""
SET P(11)=$EXTRACT($PIECE(P(2),".",2)_"0000",1,4)
+6 SET PSGMARTS=P(11)
SET PSGMARGD=QQ
+7 KILL TS
DO TS^PSGMAR3(P(11))
+8 QUIT
+9 ;
PRTIV ; Set up order info on IV label.
+1 SET MARLB(1)=$EXTRACT(P("LOG"),1,5)_" |"
+2 IF ON["P"
IF +$GET(^PS(53.1,+ON,4))
SET MARLB(1)=MARLB(1)_"P E N D I N G"
+3 IF '$TEST
SET MARLB(1)=MARLB(1)_$EXTRACT(P(2),1,5)_$EXTRACT(P(2),9,14)
SET X=$SELECT(ON["P":"",P(3)=1:"********",1:$$ENDTC1^PSGMI(P(3)))
SET MARLB(1)=$$SETSTR^VALM1(" |"_X,MARLB(1),19,16)
+4 SET MARLB(1)=$$SETSTR^VALM1("("_PSGLBS5_")",MARLB(1),36,7)
+5 NEW NAME
SET L=2
+6 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
Begin DoDot:1
+7 SET MARLB(L)=NAME(Y)
if L=2
SET MARLB(L)=$$SETSTR^VALM1(PSGST,MARLB(L),42,1)
DO L(1)
End DoDot:1
+8 if $GET(DRG("SOL",0))
SET MARLB(L)="in "
NEW PSJPRT2
+9 FOR X=0:0
SET X=$ORDER(DRG("SOL",X))
if 'X
QUIT
DO NAME^PSIVUTL(DRG("SOL",X),47,.NAME,1)
Begin DoDot:1
+10 FOR Y=0:0
SET Y=$ORDER(NAME(Y))
if 'Y
QUIT
if (Y>1)
SET L=L+1
SET MARLB(L)=$$SETSTR^VALM1(NAME(Y),$GET(MARLB(L)),4,$LENGTH(NAME(Y)))
DO L(1)
+11 SET PSJPRT2=$PIECE(^PS(52.7,+DRG("SOL",X),0),U,4)
IF PSJPRT2]""
if (Y>1)
SET L=L+1
SET MARLB(L)=" "_PSJPRT2
DO L(1)
End DoDot:1
+12 SET MARLB(L)=$PIECE(P("MR"),U,2)_" "_P(9)_" "_P(8)
+13 ;I P(4)="C",'(L#4),P("OPI")="" S L=L+1,MARLB(L)=$G(MARLB(L))_"*CAUTION-CHEMOTHERAPY*" S L=L+1 Q
+14 IF P(4)="C"
IF '(L#4)
IF P("OPI")=""
DO L(1)
SET MARLB(L)=$GET(MARLB(L))_"*CAUTION-CHEMOTHERAPY*"
DO L(1)
+15 IF P(4)'="C"
IF (P("OPI")="")
SET L=L+1
+16 IF P("OPI")'=""
DO L(1)
Begin DoDot:1
+17 ;**PSJ*5.0*237-Prevent sentence cutoff
FOR Y=1:1:$LENGTH($PIECE(P("OPI"),"^")," ")
if $LENGTH($PIECE($PIECE(P("OPI"),"^")," ",Y)_" ")+$LENGTH($GET(MARLB(L)))>42
DO L(1)
SET MARLB(L)=$GET(MARLB(L))_$PIECE($PIECE(P("OPI"),"^")," ",Y)_" "
+18 SET L=L+1
End DoDot:1
+19 IF (L#5)>0
SET X=0
FOR
if X
QUIT
Begin DoDot:1
+20 DO L(0)
SET MARLB(L)=""
SET L=L+1
+21 IF TS
IF (L>TS)
IF '(L#5)
SET X=1
QUIT
+22 IF TS=0
IF '(L#5)
SET X=1
QUIT
End DoDot:1
+23 SET MARLB(L)=$$SETSTR^VALM1("RPH: "_PSGLRPH,$GET(MARLB(L)),23,10)
+24 SET MARLB(L)=$$SETSTR^VALM1("RN: "_PSGLRN,$GET(MARLB(L)),33,9)
+25 QUIT
+26 ;
L(X) ;***Check to see if a new block if needed.
+1 SET L=L+X
+2 IF L#5=0
SET MARLB(L)="See next label for continuation"
SET L=L+1
+3 QUIT
INITOPI ;* Set nurse's initial and the other print info.
+1 DO RPHINIT^PSGMIV(.PSGLRPH)
+2 SET PSGLRN="_____"
+3 if ON["P"
SET PSGLRN=+$GET(^PS(53.1,+ON,4))
if ON["V"
SET PSGLRN=+$GET(^PS(55,DFN,"IV",+ON,4))
+4 IF PSGLRN
IF $DATA(^VA(200,+PSGLRN,0))#2
SET X=^(0)
SET X=$SELECT($PIECE(X,"^",2)]"":$PIECE(X,"^",2),1:$PIECE(X,"^"))
SET PSGLRN=$SELECT(X'[",":X,1:$EXTRACT(X,$FIND(X,","))_$EXTRACT(X))
+5 if $GET(PSGLRN)=0
SET PSGLRN="_____"
+6 IF ON["P"
Begin DoDot:1
+7 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"
+8 SET PSGST=""
End DoDot:1
+9 QUIT
