PSGDS ;BIR/CML3-DISCHARGE ORDERS ;21 JUL 94 / 3:12 PM
 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
 N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
 ;
 D ENCV^PSGSETU I $D(XQUIT) Q
 W ! S DIR(0)="Y",DIR("A")="Print BLANK Authorized Absence/Discharge Summary forms",DIR("B")="NO"
 S DIR("?",1)="Answer ""Yes"" if you want the report to print Authorized Absence/",DIR("?",2)="Discharge Summary forms for patients with no orders. Otherwise,",DIR("?")="enter ""No""."
 D ^DIR K DIR Q:Y["^"  S PSGBLANK=Y K ^TMP("PSGDS",$J)
 S (PSGP,PSGAPWD,PSGAPWG)=0,(PSGAPWDN,PSGAPWGN)="",PSGSSH="GENERIC" S PSGPTMP=0,PPAGE=1 D GWP^PSJPDIR Q:'$D(PSJSEL)  D @PSJSEL("SELECT"),EN^PSGDS0
 ;
DONE ;
 D ENKV^PSGSETU K CA,CML,CNTR,DIAG,ELIG,I1,I2,I3,PSGAP,PSGAPWD,PSGAPWDN,PSGAPWG,PSGAPWGN,PSGBLANK,PSGDICA,PSGPAT,PSJSEL,PSGSSH,T,N
 K LQ,ST,STT,STP,DF,DO,DRG,FD,NC,ND,ND2,NF,NP,PSJJORD,PSJOPC,PN,RB,RTE,SD,SI,SM,ST,STRT,VAEL,PSJACNWP,DDRG,^TMP("PSGDS",$J) Q
 ;
G ; get ward group
 S PSGAPWG=+PSJSEL("WG"),PSGAPWGN=$P(PSJSEL("WG"),"^",2) Q
 ;
W ; get ward
 S PSGAPWD=+PSJSEL("W"),PSGAPWDN=$P(PSJSEL("W"),"^",2) Q
 ;
P ; get patient
 N PAT S PAT="" F  S PAT=$O(PSJSEL("P",PAT)) Q:PAT=""  S PSGPAT(PAT)=$O(PSJSEL("P",PAT,PSGP))
 K PSGDICA Q
 ;
ENOR ;
 D ENCV^PSGSETU I '$D(XQUIT) S PSGPAT(PSGP)=+ORVP,PSJSEL("SELECT")="P",(PSGAPWD,PSGAPWDN,PSGAPWG,PSGAPWGN)="" D EN^PSGDS0
 G DONE
 ;
DTM ;
 S Y=%DT(0) D D^DIQ S T=$P(Y,"@",2),Y=$P(Y,",")
 W !!?2,"If a ",N," date is entered, a discharge summary will print for only those",!,"patients that have at least one active order with a ",$S(N["A":"STOP",1:"START")," DATE on or ",$S(N["A":"after",1:"before"),!,"the ",N," date entered."
 W !?2,"Entry is not required.  If neither date is entered, all patients with active",!,"orders will print (for the ward(s) chosen).  Enter an up-arrow (^) to exit."
 W !?2,"If you wish to enter a ",$S(N["A":"start",1:"stop")," date of ",Y,", you must enter a TIME of day",!,"of ",T," or greater.  Any date after ",Y," does not need time entered.",! S Y=-1 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGDS   2025     printed  Sep 23, 2025@19:37:11                                                                                                                                                                                                       Page 2
PSGDS     ;BIR/CML3-DISCHARGE ORDERS ;21 JUL 94 / 3:12 PM
 +1       ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
 +2        NEW PSJNEW,PSGPTMP,PPAGE
           SET PSJNEW=1
 +3       ;
 +4        DO ENCV^PSGSETU
           IF $DATA(XQUIT)
               QUIT 
 +5        WRITE !
           SET DIR(0)="Y"
           SET DIR("A")="Print BLANK Authorized Absence/Discharge Summary forms"
           SET DIR("B")="NO"
 +6        SET DIR("?",1)="Answer ""Yes"" if you want the report to print Authorized Absence/"
           SET DIR("?",2)="Discharge Summary forms for patients with no orders. Otherwise,"
           SET DIR("?")="enter ""No""."
 +7        DO ^DIR
           KILL DIR
           if Y["^"
               QUIT 
           SET PSGBLANK=Y
           KILL ^TMP("PSGDS",$JOB)
 +8        SET (PSGP,PSGAPWD,PSGAPWG)=0
           SET (PSGAPWDN,PSGAPWGN)=""
           SET PSGSSH="GENERIC"
           SET PSGPTMP=0
           SET PPAGE=1
           DO GWP^PSJPDIR
           if '$DATA(PSJSEL)
               QUIT 
           DO @PSJSEL("SELECT")
           DO EN^PSGDS0
 +9       ;
DONE      ;
 +1        DO ENKV^PSGSETU
           KILL CA,CML,CNTR,DIAG,ELIG,I1,I2,I3,PSGAP,PSGAPWD,PSGAPWDN,PSGAPWG,PSGAPWGN,PSGBLANK,PSGDICA,PSGPAT,PSJSEL,PSGSSH,T,N
 +2        KILL LQ,ST,STT,STP,DF,DO,DRG,FD,NC,ND,ND2,NF,NP,PSJJORD,PSJOPC,PN,RB,RTE,SD,SI,SM,ST,STRT,VAEL,PSJACNWP,DDRG,^TMP("PSGDS",$JOB)
           QUIT 
 +3       ;
G         ; get ward group
 +1        SET PSGAPWG=+PSJSEL("WG")
           SET PSGAPWGN=$PIECE(PSJSEL("WG"),"^",2)
           QUIT 
 +2       ;
W         ; get ward
 +1        SET PSGAPWD=+PSJSEL("W")
           SET PSGAPWDN=$PIECE(PSJSEL("W"),"^",2)
           QUIT 
 +2       ;
P         ; get patient
 +1        NEW PAT
           SET PAT=""
           FOR 
               SET PAT=$ORDER(PSJSEL("P",PAT))
               if PAT=""
                   QUIT 
               SET PSGPAT(PAT)=$ORDER(PSJSEL("P",PAT,PSGP))
 +2        KILL PSGDICA
           QUIT 
 +3       ;
ENOR      ;
 +1        DO ENCV^PSGSETU
           IF '$DATA(XQUIT)
               SET PSGPAT(PSGP)=+ORVP
               SET PSJSEL("SELECT")="P"
               SET (PSGAPWD,PSGAPWDN,PSGAPWG,PSGAPWGN)=""
               DO EN^PSGDS0
 +2        GOTO DONE
 +3       ;
DTM       ;
 +1        SET Y=%DT(0)
           DO D^DIQ
           SET T=$PIECE(Y,"@",2)
           SET Y=$PIECE(Y,",")
 +2        WRITE !!?2,"If a ",N," date is entered, a discharge summary will print for only those",!,"patients that have at least one active order with a ",$SELECT(N["A":"STOP",1:"START")," DATE on or ",$SELECT(N["A":"after",1:"before"),!,"the ",N," date e
ntered."
 +3        WRITE !?2,"Entry is not required.  If neither date is entered, all patients with active",!,"orders will print (for the ward(s) chosen).  Enter an up-arrow (^) to exit."
 +4        WRITE !?2,"If you wish to enter a ",$SELECT(N["A":"start",1:"stop")," date of ",Y,", you must enter a TIME of day",!,"of ",T," or greater.  Any date after ",Y," does not need time entered.",!
           SET Y=-1
           QUIT