PSGDSP ;BIR/CML3-PRINT DISCHARGE ORDERS ; 12 Feb 99 / 9:54 AM
;;5.0; INPATIENT MEDICATIONS ;**8,20,60,50**;16 DEC 97
LOOP ;
D NOW^%DTC S PSGDT=%,PSGPDT=$$ENDTC2^PSGMI(PSGDT),CML=IO'=IO(0)!($E(IOST,1,2)'="C-")
U IO I '$D(^TMP("PSG",$J)) W:$Y @IOF W !?22,"AUTHORIZED ABSENCE/DISCHARGE ORDERS",?62,PSGPDT D G DONE
.W !?10,"NO ACTIVE ORDERS FOUND FOR ",$S(PSJSEL("SELECT")="G":"WARD GROUP: "_PSGAPWGN,PSJSEL("SELECT")="W":"WARD: "_PSGAPWDN,1:"PATIENT(S) SELECTED"),"."
S (DRG,ELN,LN,LINE,NC,NP,PN,STRS,WD)="",$P(ELN,"=",81)="",$P(LN,"_",53)="",$P(LINE,"-",81)="",$P(STRS,"*",57)=""
F S WD=$O(^TMP("PSG",$J,WD)) Q:WD="" F S PN=$O(^TMP("PSG",$J,WD,PN)) Q:PN="" S PI=^(PN),ELIG=^(PN,0),DFN=$P(PN,"^",2),HDR="22^ORDERS" D ENHDR^PSGDSP0,END G:NP="^" DONE
;
DONE ;
W:CML&($Y) @IOF K AD,AGE,DIR,ELN,HDR,JJ,LINE,LN,PDOB,PG,PI,PPN,PSEX,PSGPDT,PSSN,RCT,RF,SCV,STRS,TD,WD,WT,Z,PSGVAMC Q
;
;
END ;
S DRG=0 F S DRG=$O(^TMP("PSG",$J,WD,PN,DRG)) Q:DRG="" S ND=^(DRG),SI=$G(^(DRG,1)) D:$Y+18>IOSL ^PSGDSPN Q:NP="^" D ORDP
Q:NP="^" S N=N+1 I $Y+15>IOSL D ^PSGDSPN Q:NP="^"
W !,ELN,!?4,"OTHER MEDICATIONS:",!!,$J(N,3),?4,"Medication: ",LN,$E(LN,1,11),!!?4,"Outpatient Directions: ",LN,!!?4
W:ELIG "___SC ___NSC " W "Qty: _____ Refills: 0 1 2 3 4 5 6 7 8 9 10 11",!!?4,$E(LN,1,35)," ",$E(LN,1,14)," ",$E(LN,1,24)
W !?4,"Provider's Signature",?40,"DEA #",?55,"Date AND Time"
D:$Y+15>IOSL ^PSGDSPN Q:NP="^" S N=N+1 D OP D:$Y+15>IOSL ^PSGDSPN Q:NP="^" S N=N+1 D OP F N=N+1:1 Q:$Y+15>IOSL D OP
S HDR="19^INSTRUCTIONS",NC=1 D ^PSGDSPN Q:NP="^" S NC=0 W !,ELN,!?1,"DIETARY INSTRUCTIONS: (Check One)",!?1,"__ NO RESTRICTIONS __ RESTRICTIONS (Specify) ",$E(LN,1,33),!!?1,LN,$E(LN,1,26),!!?1,LN,$E(LN,1,26),! I $Y+10>IOSL D ^PSGDSPN Q:NP="^"
W !,ELN,!?1,"PHYSICAL ACTIVITY LIMITATIONS: (Check One)",!?1,"__ NO RESTRICTIONS __ RESTRICTIONS (Specify) ",$E(LN,1,33),!!?1,LN,$E(LN,1,26),!!?1,LN,$E(LN,1,26),! I $Y+11>IOSL D ^PSGDSPN Q:NP="^"
W !,ELN,!?1,"SPECIAL INSTRUCTIONS: (list print information, handouts, or other",!?1,"instructions pertinent to patient's condition)",$E(LN,1,32),!!?1,LN,$E(LN,1,26),!!?1,LN,$E(LN,1,26),! I $Y+9>IOSL D ^PSGDSPN Q:NP="^"
W !,ELN,!?1,"DIAGNOSES: ",LN,$E(LN,1,15),!!?1,LN,$E(LN,1,26),!!?1,LN,$E(LN,1,26) I $Y+21>IOSL D ^PSGDSPN Q:NP="^"
W !!!?19,$E(LN,1,35)," ",$E(LN,1,24),!?19,"Nurse's Signature",?55,"Date AND Time",!!?19,$E(LN,1,35)," ",$E(LN,1,24),!?19,"Provider's Signature",?55,"Date AND Time",!!!?19,$E(ELN,1,42),!?19,">>>>> I HAVE RECEIVED AND UNDERSTAND <<<<<"
W !?19,">>>>> MY DISCHARGE INSTRUCTIONS <<<<<",!?19,$E(ELN,1,42),!!?19,$E(LN,1,35)," ",$E(LN,1,24),!?19,"Patient's Signature",?55,"Date And Time"
F Q=$Y+5:1:IOSL-1 W !
W !?2,PPN,?40,PSSN,?78-$L(PDOB),PDOB Q
;
ORDP ;
S N=N+1,DO=$P(ND,"^"),SPH=$P(ND,"^",7),SM=$P(ND,"^",8),NF=$P(ND,"^",9),UC=$P(ND,"^",11),DDRG=$P(ND,"^",12) S:UC<1 UC="0"_UC W !,LINE,!,$J(N,3),?4 I NF W "(N/F) "
W $P(DRG,"^") W:'DDRG " (UD)" W ?56,$P(ND,"^",10),?72,UC W:(DDRG="MULTIPLE")!(DDRG="NO") !?4,"*ORDER CONTAINS "_DDRG_" DISPENSE DRUGS"
W !?4,"Inpt Dose: " D
.N MARX,I
.I DO]"" D TXT^PSGMUTL(DO_$P(ND,"^",2)_" "_$P(ND,"^",4),64) D Q
..F I=1:1:+$G(MARX) W ?16,MARX(I),!
.W $P(ND,"^",2)_" "_$P(ND,"^",4)
I SI]"" S Z=$L(SI," ") W !?4,"Special Instructions: " F X=1:1:Z S Y=$P(SI," ",X) W:$X+$L(Y)>78 !?30 W Y," "
I SPH[2 W !!?4,STRS,!?4,"* THIS IS A SCHEDULE II DRUG. A PRESCRIPTION BLANK *",!?4,"* (VA FORM 10-2277d) MUST BE USED TO ORDER THIS DRUG. *",!?4,STRS Q
I SPH["W" W !!?4,STRS,!?4,"* THIS ITEM IS NONRENEWABLE. *",!?4,"* CONTACT PHARMACY IF YOU HAVE QUESTIONS. *",!?4,STRS Q
W !!?4,"___ TAKE NO ACTION (PATIENT WILL NOT RECEIVE MEDICATION)",!!?4,"Outpatient Directions: ",LN,!!?4 W:SPH'["S"&ELIG "___SC ___NSC "
W "Qty: _____ Refills: 0 1 2 3 4 5"_$S((+SPH>2)&(+SPH<6):"",1:" 6 7 8 9 10 11")
W !!?4,$E(LN,1,35)," ",$E(LN,1,14)," ",$E(LN,1,24),!?4,"Provider's Signature",?40,"DEA #",?55,"Date AND Time" Q
;
OP ;
W !,LINE,!!,$J(N,3),?4,"Medication: ",LN,$E(LN,1,11),!!?4,"Outpatient Directions: ",LN,!!?4 W:ELIG "___SC ___NSC "
W "Qty: _____ Refills: 0 1 2 3 4 5 6 7 8 9 10 11",!!?4,$E(LN,1,35)," ",$E(LN,1,14)," ",$E(LN,1,24),!?4,"Provider's "
W "Signature",?40,"DEA #",?55,"Date AND Time" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGDSP 4351 printed Sep 23, 2025@19:37:13 Page 2
PSGDSP ;BIR/CML3-PRINT DISCHARGE ORDERS ; 12 Feb 99 / 9:54 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**8,20,60,50**;16 DEC 97
LOOP ;
+1 DO NOW^%DTC
SET PSGDT=%
SET PSGPDT=$$ENDTC2^PSGMI(PSGDT)
SET CML=IO'=IO(0)!($EXTRACT(IOST,1,2)'="C-")
+2 USE IO
IF '$DATA(^TMP("PSG",$JOB))
if $Y
WRITE @IOF
WRITE !?22,"AUTHORIZED ABSENCE/DISCHARGE ORDERS",?62,PSGPDT
Begin DoDot:1
+3 WRITE !?10,"NO ACTIVE ORDERS FOUND FOR ",$SELECT(PSJSEL("SELECT")="G":"WARD GROUP: "_PSGAPWGN,PSJSEL("SELECT")="W":"WARD: "_PSGAPWDN,1:"PATIENT(S) SELECTED"),"."
End DoDot:1
GOTO DONE
+4 SET (DRG,ELN,LN,LINE,NC,NP,PN,STRS,WD)=""
SET $PIECE(ELN,"=",81)=""
SET $PIECE(LN,"_",53)=""
SET $PIECE(LINE,"-",81)=""
SET $PIECE(STRS,"*",57)=""
+5 FOR
SET WD=$ORDER(^TMP("PSG",$JOB,WD))
if WD=""
QUIT
FOR
SET PN=$ORDER(^TMP("PSG",$JOB,WD,PN))
if PN=""
QUIT
SET PI=^(PN)
SET ELIG=^(PN,0)
SET DFN=$PIECE(PN,"^",2)
SET HDR="22^ORDERS"
DO ENHDR^PSGDSP0
DO END
if NP="^"
GOTO DONE
+6 ;
DONE ;
+1 if CML&($Y)
WRITE @IOF
KILL AD,AGE,DIR,ELN,HDR,JJ,LINE,LN,PDOB,PG,PI,PPN,PSEX,PSGPDT,PSSN,RCT,RF,SCV,STRS,TD,WD,WT,Z,PSGVAMC
QUIT
+2 ;
+3 ;
END ;
+1 SET DRG=0
FOR
SET DRG=$ORDER(^TMP("PSG",$JOB,WD,PN,DRG))
if DRG=""
QUIT
SET ND=^(DRG)
SET SI=$GET(^(DRG,1))
if $Y+18>IOSL
DO ^PSGDSPN
if NP="^"
QUIT
DO ORDP
+2 if NP="^"
QUIT
SET N=N+1
IF $Y+15>IOSL
DO ^PSGDSPN
if NP="^"
QUIT
+3 WRITE !,ELN,!?4,"OTHER MEDICATIONS:",!!,$JUSTIFY(N,3),?4,"Medication: ",LN,$EXTRACT(LN,1,11),!!?4,"Outpatient Directions: ",LN,!!?4
+4 if ELIG
WRITE "___SC ___NSC "
WRITE "Qty: _____ Refills: 0 1 2 3 4 5 6 7 8 9 10 11",!!?4,$EXTRACT(LN,1,35)," ",$EXTRACT(LN,1,14)," ",$EXTRACT(LN,1,24)
+5 WRITE !?4,"Provider's Signature",?40,"DEA #",?55,"Date AND Time"
+6 if $Y+15>IOSL
DO ^PSGDSPN
if NP="^"
QUIT
SET N=N+1
DO OP
if $Y+15>IOSL
DO ^PSGDSPN
if NP="^"
QUIT
SET N=N+1
DO OP
FOR N=N+1:1
if $Y+15>IOSL
QUIT
DO OP
+7 SET HDR="19^INSTRUCTIONS"
SET NC=1
DO ^PSGDSPN
if NP="^"
QUIT
SET NC=0
WRITE !,ELN,!?1,"DIETARY INSTRUCTIONS: (Check One)",!?1,"__ NO RESTRICTIONS __ RESTRICTIONS (Specify) ",$EXTRACT(LN,1,33),!!?1,LN,$EXTRACT(LN,1,26),!!?1,LN,$EXTRACT(LN,1,26),!
IF $Y+10>IOSL
DO ^PSGDSPN
if NP="^"
QUIT
+8 WRITE !,ELN,!?1,"PHYSICAL ACTIVITY LIMITATIONS: (Check One)",!?1,"__ NO RESTRICTIONS __ RESTRICTIONS (Specify) ",$EXTRACT(LN,1,33),!!?1,LN,$EXTRACT(LN,1,26),!!?1,LN,$EXTRACT(LN,1,26),!
IF $Y+11>IOSL
DO ^PSGDSPN
if NP="^"
QUIT
+9 WRITE !,ELN,!?1,"SPECIAL INSTRUCTIONS: (list print information, handouts, or other",!?1,"instructions pertinent to patient's condition)",$EXTRACT(LN,1,32),!!?1,LN,$EXTRACT(LN,1,26),!!?1,LN,$EXTRACT(LN,1,26),!
IF $Y+9>IOSL
DO ^PSGDSPN
if NP="^"
QUIT
+10 WRITE !,ELN,!?1,"DIAGNOSES: ",LN,$EXTRACT(LN,1,15),!!?1,LN,$EXTRACT(LN,1,26),!!?1,LN,$EXTRACT(LN,1,26)
IF $Y+21>IOSL
DO ^PSGDSPN
if NP="^"
QUIT
+11 WRITE !!!?19,$EXTRACT(LN,1,35)," ",$EXTRACT(LN,1,24),!?19,"Nurse's Signature",?55,"Date AND Time",!!?19,$EXTRACT(LN,1,35)," ",...
... $EXTRACT(LN,1,24),!?19,"Provider's Signature",?55,"Date AND Time",!!!?19,$EXTRACT(ELN,1,42),!?19,">>>>> I HAVE RECEIVED AND UNDERSTAND <<<<<"
+12 WRITE !?19,">>>>> MY DISCHARGE INSTRUCTIONS <<<<<",!?19,$EXTRACT(ELN,1,42),!!?19,$EXTRACT(LN,1,35)," ",$EXTRACT(LN,1,24),!?19,"Patient's Signature",?55,"Date And Time"
+13 FOR Q=$Y+5:1:IOSL-1
WRITE !
+14 WRITE !?2,PPN,?40,PSSN,?78-$LENGTH(PDOB),PDOB
QUIT
+15 ;
ORDP ;
+1 SET N=N+1
SET DO=$PIECE(ND,"^")
SET SPH=$PIECE(ND,"^",7)
SET SM=$PIECE(ND,"^",8)
SET NF=$PIECE(ND,"^",9)
SET UC=$PIECE(ND,"^",11)
SET DDRG=$PIECE(ND,"^",12)
if UC<1
SET UC="0"_UC
WRITE !,LINE,!,$JUSTIFY(N,3),?4
IF NF
WRITE "(N/F) "
+2 WRITE $PIECE(DRG,"^")
if 'DDRG
WRITE " (UD)"
WRITE ?56,$PIECE(ND,"^",10),?72,UC
if (DDRG="MULTIPLE")!(DDRG="NO")
WRITE !?4,"*ORDER CONTAINS "_DDRG_" DISPENSE DRUGS"
+3 WRITE !?4,"Inpt Dose: "
Begin DoDot:1
+4 NEW MARX,I
+5 IF DO]""
DO TXT^PSGMUTL(DO_$PIECE(ND,"^",2)_" "_$PIECE(ND,"^",4),64)
Begin DoDot:2
+6 FOR I=1:1:+$GET(MARX)
WRITE ?16,MARX(I),!
End DoDot:2
QUIT
+7 WRITE $PIECE(ND,"^",2)_" "_$PIECE(ND,"^",4)
End DoDot:1
+8 IF SI]""
SET Z=$LENGTH(SI," ")
WRITE !?4,"Special Instructions: "
FOR X=1:1:Z
SET Y=$PIECE(SI," ",X)
if $X+$LENGTH(Y)>78
WRITE !?30
WRITE Y," "
+9 IF SPH[2
WRITE !!?4,STRS,!?4,"* THIS IS A SCHEDULE II DRUG. A PRESCRIPTION BLANK *",!?4,"* (VA FORM 10-2277d) MUST BE USED TO ORDER THIS DRUG. *",!?4,STRS
QUIT
+10 IF SPH["W"
WRITE !!?4,STRS,!?4,"* THIS ITEM IS NONRENEWABLE. *",!?4,"* CONTACT PHARMACY IF YOU HAVE QUESTIONS. *",!?4,STRS
QUIT
+11 WRITE !!?4,"___ TAKE NO ACTION (PATIENT WILL NOT RECEIVE MEDICATION)",!!?4,"Outpatient Directions: ",LN,!!?4
if SPH'["S"&ELIG
WRITE "___SC ___NSC "
+12 WRITE "Qty: _____ Refills: 0 1 2 3 4 5"_$SELECT((+SPH>2)&(+SPH<6):"",1:" 6 7 8 9 10 11")
+13 WRITE !!?4,$EXTRACT(LN,1,35)," ",$EXTRACT(LN,1,14)," ",$EXTRACT(LN,1,24),!?4,"Provider's Signature",?40,"DEA #",?55,"Date AND Time"
QUIT
+14 ;
OP ;
+1 WRITE !,LINE,!!,$JUSTIFY(N,3),?4,"Medication: ",LN,$EXTRACT(LN,1,11),!!?4,"Outpatient Directions: ",LN,!!?4
if ELIG
WRITE "___SC ___NSC "
+2 WRITE "Qty: _____ Refills: 0 1 2 3 4 5 6 7 8 9 10 11",!!?4,$EXTRACT(LN,1,35)," ",$EXTRACT(LN,1,14)," ",$EXTRACT(LN,1,24),!?4,"Provider's "
+3 WRITE "Signature",?40,"DEA #",?55,"Date AND Time"
QUIT
