- 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 Jan 18, 2025@03:02:21 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