- ADGDMM ; IHS/ADC/PDW/ENM - DISCHARGE M'CARE/M'CAID PRINT ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- ;
- N DGIFN,R,I,D,MCRN,MCDN,INSNM,INSN,DGED,DGBD,EED,DFN,IFN,X,Y,LN
- A ; -- main
- D BD I Y=-1 D Q Q
- D ED I Y=-1 D Q Q
- D ZIS I POP D Q Q
- I $D(IO("Q")) D QUE,Q Q
- D HD,L3,PG(0),Q Q
- ;
- BD ; -- beginning date
- S %DT="AEQ",%DT("A")="Select beginning date: ",X=""
- D ^%DT S DGBD=Y-.001 Q
- ;
- ED ; -- ending date
- S %DT="AEQ",%DT("A")="Select ending date: ",X=""
- D ^%DT S DGED=Y+.9 Q
- ;
- ZIS ; -- select device
- S %ZIS="PQ" D ^%ZIS Q
- ;
- ;
- L3 ; -- loop discharges
- S DGDT=DGBD F S DGDT=$O(^DGPM("AMV3",DGDT)) Q:'DGDT!(DGDT>DGED) D
- . S DFN=0 F S DFN=$O(^DGPM("AMV3",DGDT,DFN)) Q:'DFN D
- .. S DGIFN=0 F S DGIFN=$O(^DGPM("AMV3",DGDT,DFN,DGIFN)) Q:'DGIFN D 1
- Q
- ;
- 1 ; -- check for medicaid/care
- S (R,D,I)=0
- I $D(^AUPNMCR("B",DFN)) S IFN=$O(^(DFN,0)) D MCR
- I $D(^AUPNMCD("B",DFN)) S IFN=$O(^(DFN,0)) D MCD
- I $D(^AUPNPRVT("B",DFN)) S IFN=$O(^(DFN,0)) D INS
- I (R!D!I) D PRINT
- Q
- ;
- Q ; -- cleanup
- W:IO'=IO(0)!($D(IO("S"))) @IOF D ^%ZISC Q
- ;
- MCR ; -- medicare
- F ED=0:0 S ED=$O(^AUPNMCR(IFN,"11",ED)) Q:'ED D
- . S EED=$P(^AUPNMCR(IFN,11,ED,0),U,2),R=0 I EED>DGDT!('+EED) D
- .. S R=1,MCRN=$P(^AUPNMCR(IFN,0),U,3)_$P(^AUTTMCS($P(^(0),U,4),0),U)
- Q
- ;
- MCD ; -- medicaid
- F ED=0:0 S ED=$O(^AUPNMCD(IFN,"11",ED)) Q:'ED D
- . S EED=$P(^AUPNMCD(IFN,11,ED,0),U,2),D=0
- . I EED>DGDT!('+EED) S D=1,MCDN=$P(^AUPNMCD(IFN,0),U,3)
- Q
- ;
- INS ; -- private insurance
- F ED=0:0 S ED=$O(^AUPNPRVT(IFN,"11",ED)) Q:'ED D
- . S EED=$P(^AUPNPRVT(IFN,11,ED,0),U,7),I=0 I EED>DGDT!('+EED) D
- .. S I=1,INSN=$P(^AUPNPRVT(IFN,"11",ED,0),U,2)
- .. S INSNM=$P(^AUTNINS($P(^AUPNPRVT(IFN,"11",ED,0),U,1),0),U,1)
- Q
- ;
- PRINT ; -- print
- I $Y>(IOSL-6) D PG(1)
- W !,$E($P(^DPT(DFN,0),U),1,15) ;name
- I $D(DUZ(2))&($D(^AUPNPAT(DFN,41,DUZ(2),0))) W ?17,$J($P(^(0),U,2),6)
- I D W ?25,MCDN
- I R W ?37,MCRN
- I I W ?49,$E(INSNM,1,6)," ",INSN
- S Y=+^DGPM(DGIFN,0) X ^DD("DD") W ?68,$P(Y,"@") ;discharge date
- W ! Q
- ;
- HDH ; -- heading
- U IO W !,"MEDICARE/MEDICAID LIST for Discharges from "
- S Y=DGBD+.001 X ^DD("DD") W Y," to " S Y=$P(DGED,".") X ^DD("DD") W Y
- W !!,"Patient Name",?19,"HRCN",?25,"MCAID #",?37,"MCARE #"
- W ?49,"Insurer /#",?68,"DISCHARGED"
- S LN="",$P(LN,"-",IOM)="" W !,LN Q
- ;
- QUE ; -- queued outputs
- S ZTRTN="QUE^ADGDMM",ZTIO=ION
- S ZTDESC="DISCHARGE MEDICAID/MEDICARE REPORT"
- S ZTSAVE("DGBD")="",ZTSAVE("DGED")="" D ^%ZTLOAD D ^%ZISC K ZTSK Q
- ;
- PG(Z) ; -- page
- Q:IOST'["C-" W ! N X,Y K DIR S DIR(0)="E" D ^DIR W @IOF D HDH:Z Q
- ;
- HD ;
- Q:IOST'["C-" W @IOF D HDH Q
- ADGDMM ; IHS/ADC/PDW/ENM - DISCHARGE M'CARE/M'CAID PRINT ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 ;
- +4 NEW DGIFN,R,I,D,MCRN,MCDN,INSNM,INSN,DGED,DGBD,EED,DFN,IFN,X,Y,LN
- A ; -- main
- +1 DO BD
- IF Y=-1
- DO Q
- QUIT
- +2 DO ED
- IF Y=-1
- DO Q
- QUIT
- +3 DO ZIS
- IF POP
- DO Q
- QUIT
- +4 IF $DATA(IO("Q"))
- DO QUE
- DO Q
- QUIT
- +5 DO HD
- DO L3
- DO PG(0)
- DO Q
- QUIT
- +6 ;
- BD ; -- beginning date
- +1 SET %DT="AEQ"
- SET %DT("A")="Select beginning date: "
- SET X=""
- +2 DO ^%DT
- SET DGBD=Y-.001
- QUIT
- +3 ;
- ED ; -- ending date
- +1 SET %DT="AEQ"
- SET %DT("A")="Select ending date: "
- SET X=""
- +2 DO ^%DT
- SET DGED=Y+.9
- QUIT
- +3 ;
- ZIS ; -- select device
- +1 SET %ZIS="PQ"
- DO ^%ZIS
- QUIT
- +2 ;
- +3 ;
- L3 ; -- loop discharges
- +1 SET DGDT=DGBD
- FOR
- SET DGDT=$ORDER(^DGPM("AMV3",DGDT))
- IF 'DGDT!(DGDT>DGED)
- QUIT
- Begin DoDot:1
- +2 SET DFN=0
- FOR
- SET DFN=$ORDER(^DGPM("AMV3",DGDT,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +3 SET DGIFN=0
- FOR
- SET DGIFN=$ORDER(^DGPM("AMV3",DGDT,DFN,DGIFN))
- IF 'DGIFN
- QUIT
- DO 1
- End DoDot:2
- End DoDot:1
- +4 QUIT
- +5 ;
- 1 ; -- check for medicaid/care
- +1 SET (R,D,I)=0
- +2 IF $DATA(^AUPNMCR("B",DFN))
- SET IFN=$ORDER(^(DFN,0))
- DO MCR
- +3 IF $DATA(^AUPNMCD("B",DFN))
- SET IFN=$ORDER(^(DFN,0))
- DO MCD
- +4 IF $DATA(^AUPNPRVT("B",DFN))
- SET IFN=$ORDER(^(DFN,0))
- DO INS
- +5 IF (R!D!I)
- DO PRINT
- +6 QUIT
- +7 ;
- Q ; -- cleanup
- +1 IF IO'=IO(0)!($DATA(IO("S")))
- WRITE @IOF
- DO ^%ZISC
- QUIT
- +2 ;
- MCR ; -- medicare
- +1 FOR ED=0:0
- SET ED=$ORDER(^AUPNMCR(IFN,"11",ED))
- IF 'ED
- QUIT
- Begin DoDot:1
- +2 SET EED=$PIECE(^AUPNMCR(IFN,11,ED,0),U,2)
- SET R=0
- IF EED>DGDT!('+EED)
- Begin DoDot:2
- +3 SET R=1
- SET MCRN=$PIECE(^AUPNMCR(IFN,0),U,3)_$PIECE(^AUTTMCS($PIECE(^(0),U,4),0),U)
- End DoDot:2
- End DoDot:1
- +4 QUIT
- +5 ;
- MCD ; -- medicaid
- +1 FOR ED=0:0
- SET ED=$ORDER(^AUPNMCD(IFN,"11",ED))
- IF 'ED
- QUIT
- Begin DoDot:1
- +2 SET EED=$PIECE(^AUPNMCD(IFN,11,ED,0),U,2)
- SET D=0
- +3 IF EED>DGDT!('+EED)
- SET D=1
- SET MCDN=$PIECE(^AUPNMCD(IFN,0),U,3)
- End DoDot:1
- +4 QUIT
- +5 ;
- INS ; -- private insurance
- +1 FOR ED=0:0
- SET ED=$ORDER(^AUPNPRVT(IFN,"11",ED))
- IF 'ED
- QUIT
- Begin DoDot:1
- +2 SET EED=$PIECE(^AUPNPRVT(IFN,11,ED,0),U,7)
- SET I=0
- IF EED>DGDT!('+EED)
- Begin DoDot:2
- +3 SET I=1
- SET INSN=$PIECE(^AUPNPRVT(IFN,"11",ED,0),U,2)
- +4 SET INSNM=$PIECE(^AUTNINS($PIECE(^AUPNPRVT(IFN,"11",ED,0),U,1),0),U,1)
- End DoDot:2
- End DoDot:1
- +5 QUIT
- +6 ;
- PRINT ; -- print
- +1 IF $Y>(IOSL-6)
- DO PG(1)
- +2 ;name
- WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,15)
- +3 IF $DATA(DUZ(2))&($DATA(^AUPNPAT(DFN,41,DUZ(2),0)))
- WRITE ?17,$JUSTIFY($PIECE(^(0),U,2),6)
- +4 IF D
- WRITE ?25,MCDN
- +5 IF R
- WRITE ?37,MCRN
- +6 IF I
- WRITE ?49,$EXTRACT(INSNM,1,6)," ",INSN
- +7 ;discharge date
- SET Y=+^DGPM(DGIFN,0)
- XECUTE ^DD("DD")
- WRITE ?68,$PIECE(Y,"@")
- +8 WRITE !
- QUIT
- +9 ;
- HDH ; -- heading
- +1 USE IO
- WRITE !,"MEDICARE/MEDICAID LIST for Discharges from "
- +2 SET Y=DGBD+.001
- XECUTE ^DD("DD")
- WRITE Y," to "
- SET Y=$PIECE(DGED,".")
- XECUTE ^DD("DD")
- WRITE Y
- +3 WRITE !!,"Patient Name",?19,"HRCN",?25,"MCAID #",?37,"MCARE #"
- +4 WRITE ?49,"Insurer /#",?68,"DISCHARGED"
- +5 SET LN=""
- SET $PIECE(LN,"-",IOM)=""
- WRITE !,LN
- QUIT
- +6 ;
- QUE ; -- queued outputs
- +1 SET ZTRTN="QUE^ADGDMM"
- SET ZTIO=ION
- +2 SET ZTDESC="DISCHARGE MEDICAID/MEDICARE REPORT"
- +3 SET ZTSAVE("DGBD")=""
- SET ZTSAVE("DGED")=""
- DO ^%ZTLOAD
- DO ^%ZISC
- KILL ZTSK
- QUIT
- +4 ;
- PG(Z) ; -- page
- +1 IF IOST'["C-"
- QUIT
- WRITE !
- NEW X,Y
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- WRITE @IOF
- IF Z
- DO HDH
- QUIT
- +2 ;
- HD ;
- +1 IF IOST'["C-"
- QUIT
- WRITE @IOF
- DO HDH
- QUIT
