- PSGDSP0 ;BIR/ 5:18 PM-DISCHARGE ORDERS CONT. ;22-Jun-2004 09:03;PLS
- ;;5.0; INPATIENT MEDICATIONS ;**8,20**;16 DEC 97
- ;
- ; Reference to DIS^SDROUT2 supported by DBIA #195.
- ;
- ; Modified - IHS/CIA/PLS - 06/21/04 - Line ENHDR1+2, ENHDR1+5, ENHDR1+14 and ENHDR1+17
- ENHDR ; first header for each patient
- S (N,DF)=0,PSEX=$P(PI,"^"),PDOB=$P(PI,"^",2),PSSN=$P(PI,"^",3),RB=$P(PI,"^",5),AD=$P(PI,"^",6),TD=$P(PI,"^",7),SCV=$P(PI,"^",8),SC=$P(PI,"^",9),WT=$P(PI,"^",10),PPN=$P(PN,"^"),PSGP=$P(PN,"^",2),PI=$P(PI,"^",4) S:'WT WT="NF"
- S AGE=$P(PDOB,";",2),PDOB=$P(PDOB,";"),PG=1,VAEL(3)=$P(ELIG,"^",1,2),VAEL(4)=$P(ELIG,"^",3),VAEL(6)=$P(ELIG,"^",4,5),ELIG=$S('VAEL(3):0,1:$P(VAEL(3),"^",2)<50)
- ;
- ENHDR1 ;
- S PSGVAMC=$$SITE^PSGMMAR2(80)
- ; IHS/CIA/PLS - 06/21/04 - Removed reference to VA Form
- ;W:$Y @IOF W !?+HDR,"AUTHORIZED ABSENCE/DISCHARGE ",$P(HDR,"^",2),?62,PSGPDT,!?+PSGVAMC,$P(PSGVAMC,U,2),!?1,"VA FORM: 10-7978M",!?1,"Effective Date:" W:HDR>19 ?72,"Page: 1"
- W:$Y @IOF W !?+HDR,"AUTHORIZED ABSENCE/DISCHARGE ",$P(HDR,"^",2),?62,PSGPDT,!?+PSGVAMC,$P(PSGVAMC,U,2),!?1," ",!?1,"Effective Date:" W:HDR>19 ?72,"Page: 1"
- ;I HDR>19 W !,ELN,!,"Instructions to the physician:",!?4,"A. A prescription blank (VA FORM 10-2577F) must be used for:",!?9,"1. all class II narcotics",!?9,"2. any medications marked as 'nonrenewable'"
- I HDR>19 W !,ELN,!,"Instructions to the physician:",!?4,"A. A prescription blank must be used for:",!?9,"1. all class II narcotics",!?9,"2. any medications marked as 'nonrenewable'"
- I HDR>19 W !?9,"3. any new medications in addition to those entered on this form." W !?4,"B. If a medication is not to be continued, mark ""TAKE NO ACTION"".",!?4,"C. To continue a medication, you MUST:",!?9,"1. enter directions, quantity,"
- ;I HDR>19 W " and refills",!?9,"2. sign the order, enter your DEA number, and enter the date AND time."
- I HDR>19 W " and refills",!?9,"2. sign the order and enter the date AND time."
- W !,ELN,!
- ;,!?1,PPN,?36,"Ward: "_WD,!?7,"PID: "_PSSN,?30,"Weight(kg): "_WT,?61,"Admitted: "_AD
- D ENTRY^PSJHEAD(DFN,$G(PSJOPC),PG,$G(PSJNARC),$G(PSJTEAM,1),1)
- ;W !?7,"DOB: "_PDOB_" ("_AGE_")",?37,"Sex: "_PSEX W:TD ?53,"Last Transferred: "_TD W !?3,"Inpt Dx: "_PI,?$S($L(RB)<9:61,1:69-$L(RB)),"Room-bed: "_RB,!?1,"Reactions:" D ENRCT
- W !,ELN I HDR>19,$D(^PS(53.1,"AC",PSGP)) W !!?18,"*** THIS PATIENT HAS NON-VERIFIED ORDERS. ***",!
- ;I HDR>19 W !?4,"___ AUTHORIZED ABSENCE <96 HOURS ___ AUTHORIZED ABSENCE >96 HOURS",!?8,"NUMBER OF DAYS: _____ (NO REFILLS allowed on AA/PASS meds)",!!?4,"___ REGULAR DISCHARGE ___ OPT NSC ___ SC"
- I HDR>19 W !?4,"___ AUTHORIZED ABSENCE <96 HOURS ___ AUTHORIZED ABSENCE >96 HOURS",!?8,"NUMBER OF DAYS: _____ (NO REFILLS allowed on AA/PASS meds)",!!?4,"___ REGULAR DISCHARGE "
- ;D:HDR'<22 DIS^SDROUT2 W !!?8,"Next scheduled clinic visit" W:'SCV ":" I SCV W " is on ",SCV W:SC]"" " at ",SC
- W !!?8,"Next scheduled clinic visit" W:'SCV ":" I SCV W " is on ",SCV W:SC]"" " at ",SC
- W:HDR>19 !,ELN,!?56,"Schedule",?72,"Cost per",!," No.",?10,"Medication",?56,"Type",?72,"Dose" Q
- ;
- ENRCT ;
- N DFN,GMRA,GMRAL,RCT,X S DFN=PSGP,GMRA="0^0^111" D ^GMRADPT
- S X=0 F S X=$O(GMRAL(X)) Q:'X I $P(GMRAL(X),U,2)]"" S RCT($P(GMRAL(X),U,2))=""
- W:'$D(RCT) "____________________" S RCT="" F X=1:1 S RCT=$O(RCT(RCT)) Q:RCT="" W:X>1 "," W:$X+$L(RCT)>77 ! W " ",RCT
- Q
- PSGDSP0 ;BIR/ 5:18 PM-DISCHARGE ORDERS CONT. ;22-Jun-2004 09:03;PLS
- +1 ;;5.0; INPATIENT MEDICATIONS ;**8,20**;16 DEC 97
- +2 ;
- +3 ; Reference to DIS^SDROUT2 supported by DBIA #195.
- +4 ;
- +5 ; Modified - IHS/CIA/PLS - 06/21/04 - Line ENHDR1+2, ENHDR1+5, ENHDR1+14 and ENHDR1+17
- ENHDR ; first header for each patient
- +1 SET (N,DF)=0
- SET PSEX=$PIECE(PI,"^")
- SET PDOB=$PIECE(PI,"^",2)
- SET PSSN=$PIECE(PI,"^",3)
- SET RB=$PIECE(PI,"^",5)
- SET AD=$PIECE(PI,"^",6)
- SET TD=$PIECE(PI,"^",7)
- SET SCV=$PIECE(PI,"^",8)
- SET SC=$PIECE(PI,"^",9)
- SET WT=$PIECE(PI,"^",10)
- SET PPN=$PIECE(PN,"^")
- SET PSGP=$PIECE(PN,"^",2)
- SET PI=$PIECE(PI,"^",4)
- IF 'WT
- SET WT="NF"
- +2 SET AGE=$PIECE(PDOB,";",2)
- SET PDOB=$PIECE(PDOB,";")
- SET PG=1
- SET VAEL(3)=$PIECE(ELIG,"^",1,2)
- SET VAEL(4)=$PIECE(ELIG,"^",3)
- SET VAEL(6)=$PIECE(ELIG,"^",4,5)
- SET ELIG=$SELECT('VAEL(3):0,1:$PIECE(VAEL(3),"^",2)<50)
- +3 ;
- ENHDR1 ;
- +1 SET PSGVAMC=$$SITE^PSGMMAR2(80)
- +2 ; IHS/CIA/PLS - 06/21/04 - Removed reference to VA Form
- +3 ;W:$Y @IOF W !?+HDR,"AUTHORIZED ABSENCE/DISCHARGE ",$P(HDR,"^",2),?62,PSGPDT,!?+PSGVAMC,$P(PSGVAMC,U,2),!?1,"VA FORM: 10-7978M",!?1,"Effective Date:" W:HDR>19 ?72,"Page: 1"
- +4 IF $Y
- WRITE @IOF
- WRITE !?+HDR,"AUTHORIZED ABSENCE/DISCHARGE ",$PIECE(HDR,"^",2),?62,PSGPDT,!?+PSGVAMC,$PIECE(PSGVAMC,U,2),!?1," ",!?1,"Effective Date:"
- IF HDR>19
- WRITE ?72,"Page: 1"
- +5 ;I HDR>19 W !,ELN,!,"Instructions to the physician:",!?4,"A. A prescription blank (VA FORM 10-2577F) must be used for:",!?9,"1. all class II narcotics",!?9,"2. any medications marked as 'nonrenewable'"
- +6 IF HDR>19
- WRITE !,ELN,!,"Instructions to the physician:",!?4,"A. A prescription blank must be used for:",!?9,"1. all class II narcotics",!?9,"2. any medications marked as 'nonrenewable'"
- +7 IF HDR>19
- WRITE !?9,"3. any new medications in addition to those entered on this form."
- WRITE !?4,"B. If a medication is not to be continued, mark ""TAKE NO ACTION"".",!?4,"C. To continue a medication, you MUST:",!?9,"1. enter directions, quantity,"
- +8 ;I HDR>19 W " and refills",!?9,"2. sign the order, enter your DEA number, and enter the date AND time."
- +9 IF HDR>19
- WRITE " and refills",!?9,"2. sign the order and enter the date AND time."
- +10 WRITE !,ELN,!
- +11 ;,!?1,PPN,?36,"Ward: "_WD,!?7,"PID: "_PSSN,?30,"Weight(kg): "_WT,?61,"Admitted: "_AD
- +12 DO ENTRY^PSJHEAD(DFN,$GET(PSJOPC),PG,$GET(PSJNARC),$GET(PSJTEAM,1),1)
- +13 ;W !?7,"DOB: "_PDOB_" ("_AGE_")",?37,"Sex: "_PSEX W:TD ?53,"Last Transferred: "_TD W !?3,"Inpt Dx: "_PI,?$S($L(RB)<9:61,1:69-$L(RB)),"Room-bed: "_RB,!?1,"Reactions:" D ENRCT
- +14 WRITE !,ELN
- IF HDR>19
- IF $DATA(^PS(53.1,"AC",PSGP))
- WRITE !!?18,"*** THIS PATIENT HAS NON-VERIFIED ORDERS. ***",!
- +15 ;I HDR>19 W !?4,"___ AUTHORIZED ABSENCE <96 HOURS ___ AUTHORIZED ABSENCE >96 HOURS",!?8,"NUMBER OF DAYS: _____ (NO REFILLS allowed on AA/PASS meds)",!!?4,"___ REGULAR DISCHARGE ___ OPT NSC ___ SC"
- +16 IF HDR>19
- WRITE !?4,"___ AUTHORIZED ABSENCE <96 HOURS ___ AUTHORIZED ABSENCE >96 HOURS",!?8,"NUMBER OF DAYS: _____ (NO REFILLS allowed on AA/PASS meds)",!!?4,"___ REGULAR DISCHARGE "
- +17 ;D:HDR'<22 DIS^SDROUT2 W !!?8,"Next scheduled clinic visit" W:'SCV ":" I SCV W " is on ",SCV W:SC]"" " at ",SC
- +18 WRITE !!?8,"Next scheduled clinic visit"
- IF 'SCV
- WRITE ":"
- IF SCV
- WRITE " is on ",SCV
- IF SC]""
- WRITE " at ",SC
- +19 IF HDR>19
- WRITE !,ELN,!?56,"Schedule",?72,"Cost per",!," No.",?10,"Medication",?56,"Type",?72,"Dose"
- QUIT
- +20 ;
- ENRCT ;
- +1 NEW DFN,GMRA,GMRAL,RCT,X
- SET DFN=PSGP
- SET GMRA="0^0^111"
- DO ^GMRADPT
- +2 SET X=0
- FOR
- SET X=$ORDER(GMRAL(X))
- IF 'X
- QUIT
- IF $PIECE(GMRAL(X),U,2)]""
- SET RCT($PIECE(GMRAL(X),U,2))=""
- +3 IF '$DATA(RCT)
- WRITE "____________________"
- SET RCT=""
- FOR X=1:1
- SET RCT=$ORDER(RCT(RCT))
- IF RCT=""
- QUIT
- IF X>1
- WRITE ","
- IF $X+$LENGTH(RCT)>77
- WRITE !
- WRITE " ",RCT
- +4 QUIT