ADGCRBL.m

ADGCRBL ; IHS/ADC/PDW/ENM - PRINT LIST OF COMPLETED A SHEETS ; [ 03/25/1999  11:48 AM ]

 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 ;

 W @IOF W !!?27,"LISTING OF CODED A SHEETS",!!

 ;

BDATE S %DT="AEQ",%DT("A")="Select beginning discharge date: ",X="" D ^%DT

 G END:Y=-1

 S DGZBDT=Y I $E(Y,6,7)="00" W *7,"  ?? Enter exact date" G BDATE

EDATE S %DT="AEQ",%DT("A")="Select ending discharge date: ",X="" D ^%DT

 G BDATE:Y=-1

 S DGZEDT=Y I $E(Y,6,7)="00" W *7,"  ?? Enter exact date" G EDATE

 ;

ZIS S %ZIS="PQ" D ^%ZIS G END:POP,QUE:$D(IO("Q")) U IO G ^ADGCRBL1

QUE K IO("Q") S ZTRTN="ADGCRBL1",ZTDESC="CODED A SHEETS"

 S ZTSAVE("DGZBDT")="" S ZTSAVE("DGZEDT")=""

 D ^%ZTLOAD D ^%ZISC K ZTSK

 ;

END K Y,DGZBDT,DGZEDT D HOME^%ZIS Q

ADGCRBL   ; IHS/ADC/PDW/ENM - PRINT LIST OF COMPLETED A SHEETS ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 +2       ;

 +3        WRITE @IOF

           WRITE !!?27,"LISTING OF CODED A SHEETS",!!

 +4       ;

BDATE      SET %DT="AEQ"

           SET %DT("A")="Select beginning discharge date: "

           SET X=""

           DO ^%DT

 +1        IF Y=-1

               GOTO END

 +2        SET DGZBDT=Y

           IF $EXTRACT(Y,6,7)="00"

               WRITE *7,"  ?? Enter exact date"

               GOTO BDATE

EDATE      SET %DT="AEQ"

           SET %DT("A")="Select ending discharge date: "

           SET X=""

           DO ^%DT

 +1        IF Y=-1

               GOTO BDATE

 +2        SET DGZEDT=Y

           IF $EXTRACT(Y,6,7)="00"

               WRITE *7,"  ?? Enter exact date"

               GOTO EDATE

 +3       ;

ZIS        SET %ZIS="PQ"

           DO ^%ZIS

           IF POP

               GOTO END

           IF $DATA(IO("Q"))

               GOTO QUE

           USE IO

           GOTO ^ADGCRBL1

QUE        KILL IO("Q")

           SET ZTRTN="ADGCRBL1"

           SET ZTDESC="CODED A SHEETS"

 +1        SET ZTSAVE("DGZBDT")=""

           SET ZTSAVE("DGZEDT")=""

 +2        DO ^%ZTLOAD

           DO ^%ZISC

           KILL ZTSK

 +3       ;

END        KILL Y,DGZBDT,DGZEDT

           DO HOME^%ZIS

           QUIT