ADGDODQ ; IHS/ADC/PDW/ENM - QUEUE LIST OF INPATIENT DEATHS ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
W @IOF W !!!?20,"PRINT LIST OF INPATIENT DEATHS",!!
;
;***> 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 K DIR S DIR("A")="Select Sorting Order for Report"
S DIR(0)="SO^1:By DATE;2:By Discharge SERVICE;3:By Patient NAME"
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 ^ADGDODC
QUE K IO("Q") S ZTRTN="^ADGDODC" S ZTDESC="DEATHS LISTING"
F DGI="DGBDT","DGEDT","DGTYP" S ZTSAVE(DGI)=""
D ^%ZTLOAD D ^%ZISC K ZTSK
;
END K Y,DGBDT,DGEDT,DGTYP D HOME^%ZIS Q
ADGDODQ ; IHS/ADC/PDW/ENM - QUEUE LIST OF INPATIENT DEATHS ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 WRITE @IOF
WRITE !!!?20,"PRINT LIST OF INPATIENT DEATHS",!!
+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 KILL DIR
SET DIR("A")="Select Sorting Order for Report"
+1 SET DIR(0)="SO^1:By DATE;2:By Discharge SERVICE;3:By Patient NAME"
+2 DO ^DIR
IF $DATA(DIRUT)
GOTO END
IF Y=-1
GOTO TYPE
SET DGTYP=Y
+3 ;
+4 ;***> select print device
+5 SET %ZIS="PQ"
DO ^%ZIS
IF POP
GOTO END
IF $DATA(IO("Q"))
GOTO QUE
USE IO
GOTO ^ADGDODC
QUE KILL IO("Q")
SET ZTRTN="^ADGDODC"
SET ZTDESC="DEATHS LISTING"
+1 FOR DGI="DGBDT","DGEDT","DGTYP"
SET ZTSAVE(DGI)=""
+2 DO ^%ZTLOAD
DO ^%ZISC
KILL ZTSK
+3 ;
END KILL Y,DGBDT,DGEDT,DGTYP
DO HOME^%ZIS
QUIT