- ACHSDNU ; IHS/ITSC/PMF - DENIAL UNMET NEED LIST (1/3) ; [ 10/16/2001 8:16 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- ;
- BDT W !!,"Enter the BEGINNING ISSUE DATE for this report: " D READ^ACHSFU G K:$D(DUOUT)!$D(DTOUT)!(Y="") S:Y?1"?".E Y="?" S X=Y,%DT="XEP" D ^%DT G BDT:Y<1 S ACHSBDT=Y I Y>DT D FUDT^ACHS G BDT
- ;
- EDT W !!,"Enter the ENDING ISSUE DATE for this report: " D READ^ACHSFU G K:$D(DTOUT)!(Y=""),BDT:$D(DUOUT) S:Y?1"?".E Y="?" S X=Y,%DT="XEP" D ^%DT G EDT:Y<1 S ACHSEDT=Y I Y>DT D FUDT^ACHS G EDT
- I ACHSEDT<ACHSBDT W !!,*7,"The END is before the BEGINNING." G BDT
- S ACHSIO=IO
- ;
- DEV S %ZIS="OPQ" D ^%ZIS I POP G K
- G:'$D(IO("Q")) ^ACHSDNU1 K IO("Q") I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
- X ^%ZOSF("UCI") S ZTRTN="^ACHSDNU1",ZTUCI=Y,ZTDESC="CHS UNMET Need List, "_$E(ACHSBDT,2,7)_" to "_$E(ACHSEDT,2,7)
- F ACHS="ACHSBDT","ACHSEDT","DUZ(2)" S ZTSAVE(ACHS)=""
- D ^%ZTLOAD G:'$D(ZTSK) DEV
- K D ^%ZISC K ACHS,ACHSBDT,ACHSEDT,ACHSIO,ACHSQIO,DTOUT,DUOUT,ZTIO,ZTSK
- Q
- ACHSDNU ; IHS/ITSC/PMF - DENIAL UNMET NEED LIST (1/3) ; [ 10/16/2001 8:16 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- +2 ;
- BDT WRITE !!,"Enter the BEGINNING ISSUE DATE for this report: "
- DO READ^ACHSFU
- IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
- GOTO K
- IF Y?1"?".E
- SET Y="?"
- SET X=Y
- SET %DT="XEP"
- DO ^%DT
- IF Y<1
- GOTO BDT
- SET ACHSBDT=Y
- IF Y>DT
- DO FUDT^ACHS
- GOTO BDT
- +1 ;
- EDT WRITE !!,"Enter the ENDING ISSUE DATE for this report: "
- DO READ^ACHSFU
- IF $DATA(DTOUT)!(Y="")
- GOTO K
- IF $DATA(DUOUT)
- GOTO BDT
- IF Y?1"?".E
- SET Y="?"
- SET X=Y
- SET %DT="XEP"
- DO ^%DT
- IF Y<1
- GOTO EDT
- SET ACHSEDT=Y
- IF Y>DT
- DO FUDT^ACHS
- GOTO EDT
- +1 IF ACHSEDT<ACHSBDT
- WRITE !!,*7,"The END is before the BEGINNING."
- GOTO BDT
- +2 SET ACHSIO=IO
- +3 ;
- DEV SET %ZIS="OPQ"
- DO ^%ZIS
- IF POP
- GOTO K
- +1 IF '$DATA(IO("Q"))
- GOTO ^ACHSDNU1
- KILL IO("Q")
- IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
- WRITE *7,!,"Please queue to system printers."
- DO ^%ZISC
- GOTO DEV
- +2 XECUTE ^%ZOSF("UCI")
- SET ZTRTN="^ACHSDNU1"
- SET ZTUCI=Y
- SET ZTDESC="CHS UNMET Need List, "_$EXTRACT(ACHSBDT,2,7)_" to "_$EXTRACT(ACHSEDT,2,7)
- +3 FOR ACHS="ACHSBDT","ACHSEDT","DUZ(2)"
- SET ZTSAVE(ACHS)=""
- +4 DO ^%ZTLOAD
- IF '$DATA(ZTSK)
- GOTO DEV
- K DO ^%ZISC
- KILL ACHS,ACHSBDT,ACHSEDT,ACHSIO,ACHSQIO,DTOUT,DUOUT,ZTIO,ZTSK
- +1 QUIT
