PSGOEPO ;BIR/CML3-PRINT ORDERS ENTERED BY PROVIDER ;12 Mar 98 / 3:23 PM
;;5.0; INPATIENT MEDICATIONS ;**8,58**;16 DEC 97
;
; Reference to ^PS(51.2 is supported by DBIA 2178.
; Reference to ^PS(55 is supported by DBIA 2191.
;
K %ZIS,IO("Q"),ZTSAVE S IOP=$P(PSJSYSO,"^"),%ZIS=$S($P(PSJSYSO,"^",2)=IO:"",1:"NQ") D ^%ZIS K IOP I $P(PSJSYSO,"^",2)=IO(0) G ENQOP
S PSGTIR="ENQOP^PSGOEPO",PSGTID=$H,ZTDESC="PROVIDER ORDERS PRINT",ZTSAVE("PSGOEPOF")="",ZTSAVE("PSJSYSU")="" S:PSGOEPOF'="A" ZTSAVE("PSGOP")="" D ENTSK^PSGTI K ZTSK G DONE
;
ENQOP ;
S TITLE=$P($G(^VA(200,DUZ,0)),"^") S:TITLE="" TITLE="Provider's Signature" S $P(LN1,"-",81)="" D NOW^%DTC S PSGOEPOD=$$ENDTC2^PSGMI(%) U IO
I PSGOEPOF="A" F PSGOP=0:0 S PSGOP=$O(^PS(53.44,DUZ,1,PSGOP)) Q:'PSGOP I $O(^(PSGOP,1,0)) D PO
I PSGOEPOF="A" G LAST
;
PO ;
D ^PSGLPI,HEADER S MORE=1,OCNT=0,PSGOEPOA="",PSGLTD=$P($G(^PS(55,PSGOP,5.1)),"^",4) F X="PSGLAD","PSGLTD" S @X=$E($$ENDTC2^PSGMI(@X),1,10)
F PSGOE=0:0 S PSGOEPOA=$O(^PS(53.44,DUZ,1,PSGOP,1,"AA",PSGOEPOA)) Q:PSGOEPOA="" F PSGOEPO=0:0 S PSGOEPO=$O(^PS(53.44,DUZ,1,PSGOP,1,"AA",PSGOEPOA,PSGOEPO)) Q:'PSGOEPO I $D(^PS(53.44,DUZ,1,PSGOP,1,PSGOEPO,0)) S PSGORD=^(0) D OPRT
S DA(1)=DUZ,DA=PSGOP,DIK="^PS(53.44,"_DA(1)_",1," D ^DIK Q:PSGOEPOF="A"
;
LAST ;
S MORE=0 D BTM W:$Y @IOF,@IOF D ^%ZISC
;
DONE ;
K AD,DA,DIK,DO,FD,LN1,MORE,MR,ND,ND1,ND2,ND6,OCNT,OD,PSGID,PSGOD,PSGOEPO,PSGOEPOD,PSGOEPOF,PSGORD,SD,ST Q
;
W:$Y @IOF W !!?2,"NURSE: Remove one copy and send to Pharmacy.",!!!!!,LN1,!?1,"VA FORM 10-1158",?21,"PROVIDER'S MEDICATION ORDERS",?53,"Printed: ",PSGOEPOD,!,LN1
W !?3,"|Date/|",?33,"ORDERS",?58,"| | Nurse's",!,"No.|Time |Action",?19,"Check here if NO SUBSTITUTE allowed. ->",?58,"| | Signature",!,LN1
Q
;
OPRT ;
S OD=$P(PSGORD,"^",3),PSGORD=$P(PSGORD,"^"),ND=$S(PSGORD["N":"^PS(53.1,"_+PSGORD,1:"^PS(55,"_PSGOP_",5,"_+PSGORD),ND=$G(@(ND_",0)")),ND2=$G(^(2)),ND6=$G(^(6)),ND1=$G(^(.1))
S MR=$P(ND,"^",3),ST=$P(ND,"^",7),ND=$P(ND,"^",9),SD=$P(ND2,"^",2),FD=$P(ND2,"^",4),AD=$P(ND2,"^",5),ND2=$P(ND2,"^"),DO=$P(ND1,"^",2),ND1=$P(ND1,"^") S:ST="P" ST="PRN" F X="SD","FD","OD" S @X=$$ENDTC^PSGMI(@X)
S MR=$S('$D(^PS(51.2,+MR,0)):MR_";PS(51.2,",$P(^(0),"^",3)]"":$P(^(0),"^",3),$P(^(0),"^")]"":$P(^(0),"^"),1:MR_";PS(51.2"),ND1=$S(ND1'=+ND1:"*"_ND1,'$D(^PS(50.3,+ND1,0)):ND1,$P(^(0),"^")]"":$P(^(0),"^"),1:ND1_";PS(50.3,")
I ND6]"" S ND6=$$ENSET^PSGSICHK($P(ND6,"^"))
D:$Y+10>IOSL BTM,HEADER S OCNT=OCNT+1 W !,$J(OCNT,3),"|",$E(OD,1,5),"|",$S(PSGOEPOA="C":"DC ",PSGOEPOA="R":"RNW",PSGOEPOA="W":"NEW",1:"???"),"|",ND1,?58-$L(ST),ST,?58,"| |"
W !?3,"|",$P(OD," ",2),"| | Give: ",DO,$E(" ",DO]""),MR," ",ND2,?58,"| | ",$S(PSGOEPOA'="N":"",ND="A":"ORDER ACTIVE",ND["D":"ORDER DC'D",ND="E":"ORDER EXP'D",1:"")
I AD]"" W !?3,"| | |",?58-$L(AD),AD,"| |"
I ND6]"" W !?3,"| | |" F Q=1:1:$L(ND6," ") S QQ=$P(ND6," ",Q) W:$X+$L(QQ)>57 ?58,"| |",!?3,"| | |" W QQ," "
W:ND6]"" ?58,"| |" W !,LN1 Q
Q
;
BTM ;
I $Y+11'>IOSL F Q=$Y:1:IOSL-12 W !
W !?25,"_______________",?45,"______________________________",!?25,"Date AND Time",?45,TITLE,!! I MORE W ?36,"THIS PATIENT'S ORDERS CONTINUE ON NEXT PAGE"
W !,LN1,!?1,PSGLPN,?36,"Ward: ",PSGLWDN,!?7,"PID: ",PSGLSSN,?32,"Room-Bed: ",PSGLRB,?59,"Admitted: ",PSGLAD,!?7,"DOB: ",PSGLDOB," (",PSGLAGE,")",?37,"Sex: ",PSGLSEX I PSGLTD W ?56,"Last Transfer: ",PSGLTD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOEPO 3415 printed Sep 23, 2025@19:38:27 Page 2
PSGOEPO ;BIR/CML3-PRINT ORDERS ENTERED BY PROVIDER ;12 Mar 98 / 3:23 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**8,58**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(51.2 is supported by DBIA 2178.
+4 ; Reference to ^PS(55 is supported by DBIA 2191.
+5 ;
+6 KILL %ZIS,IO("Q"),ZTSAVE
SET IOP=$PIECE(PSJSYSO,"^")
SET %ZIS=$SELECT($PIECE(PSJSYSO,"^",2)=IO:"",1:"NQ")
DO ^%ZIS
KILL IOP
IF $PIECE(PSJSYSO,"^",2)=IO(0)
GOTO ENQOP
+7 SET PSGTIR="ENQOP^PSGOEPO"
SET PSGTID=$HOROLOG
SET ZTDESC="PROVIDER ORDERS PRINT"
SET ZTSAVE("PSGOEPOF")=""
SET ZTSAVE("PSJSYSU")=""
if PSGOEPOF'="A"
SET ZTSAVE("PSGOP")=""
DO ENTSK^PSGTI
KILL ZTSK
GOTO DONE
+8 ;
ENQOP ;
+1 SET TITLE=$PIECE($GET(^VA(200,DUZ,0)),"^")
if TITLE=""
SET TITLE="Provider's Signature"
SET $PIECE(LN1,"-",81)=""
DO NOW^%DTC
SET PSGOEPOD=$$ENDTC2^PSGMI(%)
USE IO
+2 IF PSGOEPOF="A"
FOR PSGOP=0:0
SET PSGOP=$ORDER(^PS(53.44,DUZ,1,PSGOP))
if 'PSGOP
QUIT
IF $ORDER(^(PSGOP,1,0))
DO PO
+3 IF PSGOEPOF="A"
GOTO LAST
+4 ;
PO ;
+1 DO ^PSGLPI
DO HEADER
SET MORE=1
SET OCNT=0
SET PSGOEPOA=""
SET PSGLTD=$PIECE($GET(^PS(55,PSGOP,5.1)),"^",4)
FOR X="PSGLAD","PSGLTD"
SET @X=$EXTRACT($$ENDTC2^PSGMI(@X),1,10)
+2 FOR PSGOE=0:0
SET PSGOEPOA=$ORDER(^PS(53.44,DUZ,1,PSGOP,1,"AA",PSGOEPOA))
if PSGOEPOA=""
QUIT
FOR PSGOEPO=0:0
SET PSGOEPO=$ORDER(^PS(53.44,DUZ,1,PSGOP,1,"AA",PSGOEPOA,PSGOEPO))
if 'PSGOEPO
QUIT
IF $DATA(^PS(53.44,DUZ,1,PSGOP,1,PSGOEPO,0))
SET PSGORD=^(0)
DO OPRT
+3 SET DA(1)=DUZ
SET DA=PSGOP
SET DIK="^PS(53.44,"_DA(1)_",1,"
DO ^DIK
if PSGOEPOF="A"
QUIT
+4 ;
LAST ;
+1 SET MORE=0
DO BTM
if $Y
WRITE @IOF,@IOF
DO ^%ZISC
+2 ;
DONE ;
+1 KILL AD,DA,DIK,DO,FD,LN1,MORE,MR,ND,ND1,ND2,ND6,OCNT,OD,PSGID,PSGOD,PSGOEPO,PSGOEPOD,PSGOEPOF,PSGORD,SD,ST
QUIT
+2 ;
+1 if $Y
WRITE @IOF
WRITE !!?2,"NURSE: Remove one copy and send to Pharmacy.",!!!!!,LN1,!?1,"VA FORM 10-1158",?21,"PROVIDER'S MEDICATION ORDERS",?53,"Printed: ",PSGOEPOD,!,LN1
+2 WRITE !?3,"|Date/|",?33,"ORDERS",?58,"| | Nurse's",!,"No.|Time |Action",?19,"Check here if NO SUBSTITUTE allowed. ->",?58,"| | Signature",!,LN1
+3 QUIT
+4 ;
OPRT ;
+1 SET OD=$PIECE(PSGORD,"^",3)
SET PSGORD=$PIECE(PSGORD,"^")
SET ND=$SELECT(PSGORD["N":"^PS(53.1,"_+PSGORD,1:"^PS(55,"_PSGOP_",5,"_+PSGORD)
SET ND=$GET(@(ND_",0)"))
SET ND2=$GET(^(2))
SET ND6=$GET(^(6))
SET ND1=$GET(^(.1))
+2 SET MR=$PIECE(ND,"^",3)
SET ST=$PIECE(ND,"^",7)
SET ND=$PIECE(ND,"^",9)
SET SD=$PIECE(ND2,"^",2)
SET FD=$PIECE(ND2,"^",4)
SET AD=$PIECE(ND2,"^",5)
SET ND2=$PIECE(ND2,"^")
SET DO=$PIECE(ND1,"^",2)
SET ND1=$PIECE(ND1,"^")
if ST="P"
SET ST="PRN"
FOR X="SD","FD","OD"
SET @X=$$ENDTC^PSGMI(@X)
+3 SET MR=$SELECT('$DATA(^PS(51.2,+MR,0)):MR_";PS(51.2,",$PIECE(^(0),"^",3)]"":$PIECE(^(0),"^",3),$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:MR_";PS(51.2")
SET ND1=$SELECT(ND1'=+ND1:"*"_ND1,'$DATA(^PS(50.3,+ND1,0)):ND1,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:ND1_";PS(50.3,")
+4 IF ND6]""
SET ND6=$$ENSET^PSGSICHK($PIECE(ND6,"^"))
+5 if $Y+10>IOSL
DO BTM
DO HEADER
SET OCNT=OCNT+1
WRITE !,$JUSTIFY(OCNT,3),"|",$EXTRACT(OD,1,5),"|",$SELECT(PSGOEPOA="C":"DC ",PSGOEPOA="R":"RNW",PSGOEPOA="W":"NEW",1:"???"),"|",ND1,?58-$LENGTH(ST),ST,?58,"| |"
+6 WRITE !?3,"|",$PIECE(OD," ",2),"| | Give: ",DO,$EXTRACT(" ",DO]""),MR," ",ND2,?58,"| | ",$SELECT(PSGOEPOA'="N":"",ND="A":"ORDER ACTIVE",ND["D":"ORDER DC'D",ND="E":"ORDER EXP'D",1:"")
+7 IF AD]""
WRITE !?3,"| | |",?58-$LENGTH(AD),AD,"| |"
+8 IF ND6]""
WRITE !?3,"| | |"
FOR Q=1:1:$LENGTH(ND6," ")
SET QQ=$PIECE(ND6," ",Q)
if $X+$LENGTH(QQ)>57
WRITE ?58,"| |",!?3,"| | |"
WRITE QQ," "
+9 if ND6]""
WRITE ?58,"| |"
WRITE !,LN1
QUIT
+10 QUIT
+11 ;
BTM ;
+1 IF $Y+11'>IOSL
FOR Q=$Y:1:IOSL-12
WRITE !
+2 WRITE !?25,"_______________",?45,"______________________________",!?25,"Date AND Time",?45,TITLE,!!
IF MORE
WRITE ?36,"THIS PATIENT'S ORDERS CONTINUE ON NEXT PAGE"
+3 WRITE !,LN1,!?1,PSGLPN,?36,"Ward: ",PSGLWDN,!?7,"PID: ",PSGLSSN,?32,"Room-Bed: ",PSGLRB,?59,"Admitted: ",PSGLAD,!?7,"DOB: ",PSGLDOB," (",PSGLAGE,")",?37,"Sex: ",PSGLSEX
IF PSGLTD
WRITE ?56,"Last Transfer: ",PSGLTD
+4 QUIT
