- ADGLDCQ ; IHS/ADC/PDW/ENM - QUEUE LIST OF DISCHARGES ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- W @IOF W !!!?20,"PRINT LIST OF DISCHARGES",!!
- ;
- ;***> select date range
- DATE S %DT="AEQ",%DT("A")="Beginning date: ",X="" D ^%DT
- G END:Y=-1 S DGBDT=Y
- DATE2 S %DT="AEQ",%DT("A")="Ending date: ",X="" D ^%DT G DATE:Y=-1 S DGEDT=Y
- I DGEDT<DGBDT W *7,!!?5,"Ending date MUST NOT be before beginning date",! G DATE2
- I DGEDT'<DT S X1=DT,X2=-1 D C^%DTC S DGEDT=X
- ;
- ;***> select type of report
- TYPE K DIR S DIR("A",1)="Select Sorting Order for Report:"
- S DIR("A",2)=" 1. By DATE",DIR("A",3)=" 2. By WARD"
- S DIR("A",4)=" 3. By SERVICE"
- SELECT S DIR("A")="Select (1, 2, or 3): ",DIR(0)="NAO^1:3" D ^DIR
- G END:$D(DTOUT),DATE2:X="",END:$D(DUOUT),TYPE:Y=-1 S DGTYP=Y
- G DEV:DGTYP=1
- ;
- ALL ;***> choose one or all wards or services
- K DIR S DIR(0)="Y"
- S DIR("A")=$S(DGTYP=2:"Print for All Wards",1:"Print for All Services")
- S DIR("B")="NO" D ^DIR I Y=1 S DGSRT="A" G DEV ;all wards or serv
- I $D(DIRUT) G END ;check for timeout,"^", or null
- ;
- ONE ;***> choose which ward or service to print
- K DIR S DIR(0)=$S(DGTYP=2:"PO^42:EMQZ",1:"PO^45.7:EMQZ") D ^DIR
- G END:$D(DTOUT),ALL:X="",END:$D(DUOUT),ONE:Y=-1
- I DGTYP=2 I $D(^DIC(42,+Y,"I")),$P(^("I"),U)="I" W *7,?40,"** INACTIVE WARD **" G ONE
- I DGTYP=3 I $P(^DIC(45.7,+Y,9999999),U,3)'="Y" W *7,!?35,"** NOT AN ADMITTING SERVICE! **" G ONE
- S DGSRT=Y
- ;
- ;***> select print device
- DEV S %ZIS="PQ" D ^%ZIS G END:POP,QUE:$D(IO("Q")) U IO G ^ADGLDCC
- QUE K IO("Q") S ZTRTN="^ADGLDCC" S ZTDESC="ADMITS LISTING"
- F DGI="DGBDT","DGEDT","DGTYP","DGSRT" S ZTSAVE(DGI)=""
- D ^%ZTLOAD D ^%ZISC K ZTSK
- ;
- END K Y,DGBDT,DGEDT,DGTYP,DGSRT,DIR,DGI D HOME^%ZIS Q
- ADGLDCQ ; IHS/ADC/PDW/ENM - QUEUE LIST OF DISCHARGES ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 WRITE @IOF
- WRITE !!!?20,"PRINT LIST OF DISCHARGES",!!
- +4 ;
- +5 ;***> select date range
- DATE SET %DT="AEQ"
- SET %DT("A")="Beginning date: "
- SET X=""
- DO ^%DT
- +1 IF Y=-1
- GOTO END
- SET DGBDT=Y
- DATE2 SET %DT="AEQ"
- SET %DT("A")="Ending date: "
- SET X=""
- DO ^%DT
- IF Y=-1
- GOTO DATE
- SET DGEDT=Y
- +1 IF DGEDT<DGBDT
- WRITE *7,!!?5,"Ending date MUST NOT be before beginning date",!
- GOTO DATE2
- +2 IF DGEDT'<DT
- SET X1=DT
- SET X2=-1
- DO C^%DTC
- SET DGEDT=X
- +3 ;
- +4 ;***> select type of report
- TYPE KILL DIR
- SET DIR("A",1)="Select Sorting Order for Report:"
- +1 SET DIR("A",2)=" 1. By DATE"
- SET DIR("A",3)=" 2. By WARD"
- +2 SET DIR("A",4)=" 3. By SERVICE"
- SELECT SET DIR("A")="Select (1, 2, or 3): "
- SET DIR(0)="NAO^1:3"
- DO ^DIR
- +1 IF $DATA(DTOUT)
- GOTO END
- IF X=""
- GOTO DATE2
- IF $DATA(DUOUT)
- GOTO END
- IF Y=-1
- GOTO TYPE
- SET DGTYP=Y
- +2 IF DGTYP=1
- GOTO DEV
- +3 ;
- ALL ;***> choose one or all wards or services
- +1 KILL DIR
- SET DIR(0)="Y"
- +2 SET DIR("A")=$SELECT(DGTYP=2:"Print for All Wards",1:"Print for All Services")
- +3 ;all wards or serv
- SET DIR("B")="NO"
- DO ^DIR
- IF Y=1
- SET DGSRT="A"
- GOTO DEV
- +4 ;check for timeout,"^", or null
- IF $DATA(DIRUT)
- GOTO END
- +5 ;
- ONE ;***> choose which ward or service to print
- +1 KILL DIR
- SET DIR(0)=$SELECT(DGTYP=2:"PO^42:EMQZ",1:"PO^45.7:EMQZ")
- DO ^DIR
- +2 IF $DATA(DTOUT)
- GOTO END
- IF X=""
- GOTO ALL
- IF $DATA(DUOUT)
- GOTO END
- IF Y=-1
- GOTO ONE
- +3 IF DGTYP=2
- IF $DATA(^DIC(42,+Y,"I"))
- IF $PIECE(^("I"),U)="I"
- WRITE *7,?40,"** INACTIVE WARD **"
- GOTO ONE
- +4 IF DGTYP=3
- IF $PIECE(^DIC(45.7,+Y,9999999),U,3)'="Y"
- WRITE *7,!?35,"** NOT AN ADMITTING SERVICE! **"
- GOTO ONE
- +5 SET DGSRT=Y
- +6 ;
- +7 ;***> select print device
- DEV SET %ZIS="PQ"
- DO ^%ZIS
- IF POP
- GOTO END
- IF $DATA(IO("Q"))
- GOTO QUE
- USE IO
- GOTO ^ADGLDCC
- QUE KILL IO("Q")
- SET ZTRTN="^ADGLDCC"
- SET ZTDESC="ADMITS LISTING"
- +1 FOR DGI="DGBDT","DGEDT","DGTYP","DGSRT"
- SET ZTSAVE(DGI)=""
- +2 DO ^%ZTLOAD
- DO ^%ZISC
- KILL ZTSK
- +3 ;
- END KILL Y,DGBDT,DGEDT,DGTYP,DGSRT,DIR,DGI
- DO HOME^%ZIS
- QUIT
