ACHSDNU.m

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