- ADGFTRQ ; IHS/ADC/PDW/ENM - QUEUE LIST OF FACILITY TRANSFERS ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- W @IOF W !!!?20,"PRINT LIST OF TRANSFERS TO/FROM OTHER FACILITIES",!!
- ;
- ;***> select date range
- DATE S %DT="AEQ",%DT("A")="Beginning date: ",X="" D ^%DT
- G END:Y=-1 S DGBDT=Y
- DATE2 S %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 W ! K DIR S DIR("A",1)="Select Type Of Report:",DIR("A",2)=" "
- S DIR("A",3)=" 1. LISTING only"
- S DIR("A",4)=" 2. STATISTICS only"
- S DIR("A",5)=" 3. BOTH Listing and Stats"
- SELECT S DIR("A")="Select One",DIR(0)="N0^1:3" D ^DIR
- G END:$D(DIRUT),TYPE:Y=-1 S DGTYP=Y
- ;
- ; -- select print device
- S %ZIS="PQ" D ^%ZIS G END:POP,QUE:$D(IO("Q")) U IO G ^ADGFTRC
- QUE K IO("Q") S ZTRTN="^ADGFTRC" S ZTDESC="TRANSFER REPORT"
- F DGI="DGBDT","DGEDT","DGTYP" S ZTSAVE(DGI)=""
- D ^%ZTLOAD D ^%ZISC K ZTSK
- ;
- END K Y,DGBDT,DGEDT,DGTYP,DIR D HOME^%ZIS Q
- ADGFTRQ ; IHS/ADC/PDW/ENM - QUEUE LIST OF FACILITY TRANSFERS ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 WRITE @IOF
- WRITE !!!?20,"PRINT LIST OF TRANSFERS TO/FROM OTHER FACILITIES",!!
- +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("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 WRITE !
- KILL DIR
- SET DIR("A",1)="Select Type Of Report:"
- SET DIR("A",2)=" "
- +1 SET DIR("A",3)=" 1. LISTING only"
- +2 SET DIR("A",4)=" 2. STATISTICS only"
- +3 SET DIR("A",5)=" 3. BOTH Listing and Stats"
- SELECT SET DIR("A")="Select One"
- SET DIR(0)="N0^1:3"
- DO ^DIR
- +1 IF $DATA(DIRUT)
- GOTO END
- IF Y=-1
- GOTO TYPE
- SET DGTYP=Y
- +2 ;
- +3 ; -- select print device
- +4 SET %ZIS="PQ"
- DO ^%ZIS
- IF POP
- GOTO END
- IF $DATA(IO("Q"))
- GOTO QUE
- USE IO
- GOTO ^ADGFTRC
- QUE KILL IO("Q")
- SET ZTRTN="^ADGFTRC"
- SET ZTDESC="TRANSFER REPORT"
- +1 FOR DGI="DGBDT","DGEDT","DGTYP"
- SET ZTSAVE(DGI)=""
- +2 DO ^%ZTLOAD
- DO ^%ZISC
- KILL ZTSK
- +3 ;
- END KILL Y,DGBDT,DGEDT,DGTYP,DIR
- DO HOME^%ZIS
- QUIT
