- 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
