ADGWMM.m

ADGWMM ; IHS/ADC/PDW/ENM - INPT INSURANCE LISTING ; [ 03/25/1999  11:48 AM ]

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

 ;

 D ^XBCLS W !!?15,"INPATIENT MEDICARE/MEDICAID/INSURANCE LISTING",!!

RANGE ; -- ask if user wants current inpts or range of disch dates

 K DIR S DIR("A")="Select Report Type"

 S DIR(0)="SO^1:CURRENT INPATIENTS ONLY;2:BY DISCHARGE DATE"

 D ^DIR G Q:$D(DIRUT) S DGT=Y

 I DGT=1 D 1 I $D(DIRUT) D Q Q

 I DGT=2 D 1,2 I $D(DIRUT) D Q Q

 ;

ZIS ; -- select device    

 S %ZIS="PQ" D ^%ZIS G:POP Q I $D(IO("Q")) D TM Q

 S X=$S(DGT=2:"DATE^ADGWMM1",DGW=0:"WALL^ADGWMM1",1:"WONE^ADGWMM1") D @X

 Q

 ;

TM ; -- queued outputs

 S ZTRTN=$S(DGT=2:"DATE^ADGWMM1",DGW=0:"WALL^ADGWMM1",1:"WONE^ADGWMM1")

 S ZTIO=ION,ZTDESC="WARD MEDICAID/MEDICARE REPORT"

 F I="DGT","DGW","DGBD","DGED" S ZTSAVE(I)=""

 D ^%ZTLOAD

 D HOME^%ZIS G Q

 ;

 ;

1 ; -- current inpts only: all or one ward

 NEW DIR S DIR(0)="Y0",DIR("B")="NO"

 S DIR("A")="Print for ALL WARDS" D ^DIR Q:$D(DIRUT)

 I Y=1 S DGW=0 Q

 ; -- select ward

 NEW DIR S DIR(0)="PO^42:EMQ" D ^DIR Q:$D(DIRUT)  S DGW=$P(Y,U,2)

 Q

 ;

2 ; -- discharge date range

 Q:$D(DIRUT)

 K DIR S DIR(0)="DO^::EQ",DIR("A")="Enter Earliest DISCHARGE DATE"

 D ^DIR Q:$D(DIRUT)  S DGBD=Y

 K DIR S DIR(0)="DO^::EQ",DIR("A")="Enter Latest DISCHARGE DATE"

 D ^DIR Q:$D(DIRUT)

 I Y<DGBD D  G 2

 . W !!,*7,"Ending date cannot be earlier than beginning date!"

 . W !,"Let's start over . . ",!

 S DGED=Y

 Q

 ;

Q ; -- cleanup

 I $G(DGSTOP)="",IOST["C-" D PRTOPT^ADGVAR

 D ^%ZISC

 K DGT,DGW,DGTYP,DGBD,DGED,DIR

 K W,R,I,D,MCRN,MCDN,INSNM,INSN,ED,EED,DFN,IFN,X,Y,DIC,DIC(0),T,LN Q

ADGWMM    ; IHS/ADC/PDW/ENM - INPT INSURANCE LISTING ; [ 03/25/1999  11:48 AM ]

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

 +2       ;

 +3        DO ^XBCLS

           WRITE !!?15,"INPATIENT MEDICARE/MEDICAID/INSURANCE LISTING",!!

RANGE     ; -- ask if user wants current inpts or range of disch dates

 +1        KILL DIR

           SET DIR("A")="Select Report Type"

 +2        SET DIR(0)="SO^1:CURRENT INPATIENTS ONLY;2:BY DISCHARGE DATE"

 +3        DO ^DIR

           IF $DATA(DIRUT)

               GOTO Q

           SET DGT=Y

 +4        IF DGT=1

               DO 1

               IF $DATA(DIRUT)

                   DO Q

                   QUIT 

 +5        IF DGT=2

               DO 1

               DO 2

               IF $DATA(DIRUT)

                   DO Q

                   QUIT 

 +6       ;

ZIS       ; -- select device    

 +1        SET %ZIS="PQ"

           DO ^%ZIS

           IF POP

               GOTO Q

           IF $DATA(IO("Q"))

               DO TM

               QUIT 

 +2        SET X=$SELECT(DGT=2:"DATE^ADGWMM1",DGW=0:"WALL^ADGWMM1",1:"WONE^ADGWMM1")

           DO @X

 +3        QUIT 

 +4       ;

TM        ; -- queued outputs

 +1        SET ZTRTN=$SELECT(DGT=2:"DATE^ADGWMM1",DGW=0:"WALL^ADGWMM1",1:"WONE^ADGWMM1")

 +2        SET ZTIO=ION

           SET ZTDESC="WARD MEDICAID/MEDICARE REPORT"

 +3        FOR I="DGT","DGW","DGBD","DGED"

               SET ZTSAVE(I)=""

 +4        DO ^%ZTLOAD

 +5        DO HOME^%ZIS

           GOTO Q

 +6       ;

 +7       ;

1         ; -- current inpts only: all or one ward

 +1        NEW DIR

           SET DIR(0)="Y0"

           SET DIR("B")="NO"

 +2        SET DIR("A")="Print for ALL WARDS"

           DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

 +3        IF Y=1

               SET DGW=0

               QUIT 

 +4       ; -- select ward

 +5        NEW DIR

           SET DIR(0)="PO^42:EMQ"

           DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

           SET DGW=$PIECE(Y,U,2)

 +6        QUIT 

 +7       ;

2         ; -- discharge date range

 +1        IF $DATA(DIRUT)

               QUIT 

 +2        KILL DIR

           SET DIR(0)="DO^::EQ"

           SET DIR("A")="Enter Earliest DISCHARGE DATE"

 +3        DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

           SET DGBD=Y

 +4        KILL DIR

           SET DIR(0)="DO^::EQ"

           SET DIR("A")="Enter Latest DISCHARGE DATE"

 +5        DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

 +6        IF Y<DGBD

               Begin DoDot:1

 +7                WRITE !!,*7,"Ending date cannot be earlier than beginning date!"

 +8                WRITE !,"Let's start over . . ",!

               End DoDot:1

               GOTO 2

 +9        SET DGED=Y

 +10       QUIT 

 +11      ;

Q         ; -- cleanup

 +1        IF $GET(DGSTOP)=""

               IF IOST["C-"

                   DO PRTOPT^ADGVAR

 +2        DO ^%ZISC

 +3        KILL DGT,DGW,DGTYP,DGBD,DGED,DIR

 +4        KILL W,R,I,D,MCRN,MCDN,INSNM,INSN,ED,EED,DFN,IFN,X,Y,DIC,DIC(0),T,LN

           QUIT