ACHSC6Q.m

ACHSC6Q ; IHS/ITSC/PMF - QUE CHS EXPENDITURE REPORT ;   [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 ;

BDT ; Enter beginning date.

 S ACHSBDT=$$DATE^ACHS("B","CHS EXPENDITURE")

 G K:$D(DUOUT)!$D(DTOUT)!(ACHSBDT<1)

 S %DT="F"

 F X=ACHSBDT:1 S Y=X D ^%DT I +Y<1 S X=X-1 Q

 S ACHSEMON=$$FMTE^XLFDT(X)

EDT ; Enter ending date.

 S ACHSEDT=$$DIR^XBDIR("D","Enter The ENDING Date for The CHS EXPENDITURE Report",ACHSEMON)

 G K:$D(DTOUT),BDT:$D(DUOUT)

REPORT ; Select pt/comm/age.

 W !!,"Print Report by: ",!?3,"1. By Patient",!?3,"2. By Community of Residence",!?3,"3. By Age Grouping",!?3,"4. Totals Only",!?3,"5. By Tribe",!!?5,"Enter 1 to 5  1// "

 D READ^ACHSFU

 G K:$D(DTOUT),EDT:$D(DUOUT),REPORT:Y?1"?".E

 I Y="" S ACHSRPT=1 G TYPE

 I (Y<1)!(Y>5) W !,*7 G REPORT

 S ACHSRPT=Y

TYPE ; Select in/dent./out/all.

 W !!,"Want Expenditure Report by ",$S(ACHSRPT=1:"Patient",ACHSRPT=2:"Community of Residence",1:"Age Grouping")," for: ",!!?5,"1.  Inpatient Services",!?5,"2.  Dental Services",!?5,"3.  Outpatient Serices",!?5,"4.  All Services",!

 W !,"Enter 1 thru 4   ALL// "

 D READ^ACHSFU

 G K:$D(DTOUT),REPORT:$D(DUOUT),TYPE:Y?1"?".E

 I Y="" S ACHSRPT1=4 G DEV

 I (Y<1)!(Y>4) W !,*7 G TYPE

 S ACHSRPT1=Y

DEV ; Select device.

 S %=$$PB^ACHS

 I %=U!$D(DTOUT)!$D(DUOUT) D K Q

 I %="B" D VIEWR^XBLM($S(ACHSRPT=3:"^ACHSC6D",1:"^ACHSC6C")),EN^XBVK("VALM"),K Q

 S %ZIS="OPQ"

 D ^%ZIS

 I POP D HOME^%ZIS G K

 G:'$D(IO("Q")) ^ACHSC6D:ACHSRPT=3,^ACHSC6C

 K IO("Q")

 I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV

 S ZTRTN=$S(ACHSRPT=3:"^ACHSC6D",1:"^ACHSC6C"),ZTIO="",ZTDESC="CHS EXPENDITURE REPORT #"_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL

 F %="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRPT","ACHSRPT1" S ZTSAVE(%)=""

 D ^%ZTLOAD

 G:'$D(ZTSK) DEV

K ; Kill vars, close device, quit.

 D EN^XBVK("ACHS"),^ACHSVAR

 K ZTIO,ZTSK

 D ^%ZISC

 Q

 ;

ACHSC6Q   ; IHS/ITSC/PMF - QUE CHS EXPENDITURE REPORT ;   [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

 +3       ;

BDT       ; Enter beginning date.

 +1        SET ACHSBDT=$$DATE^ACHS("B","CHS EXPENDITURE")

 +2        IF $DATA(DUOUT)!$DATA(DTOUT)!(ACHSBDT<1)

               GOTO K

 +3        SET %DT="F"

 +4        FOR X=ACHSBDT:1

               SET Y=X

               DO ^%DT

               IF +Y<1

                   SET X=X-1

                   QUIT 

 +5        SET ACHSEMON=$$FMTE^XLFDT(X)

EDT       ; Enter ending date.

 +1        SET ACHSEDT=$$DIR^XBDIR("D","Enter The ENDING Date for The CHS EXPENDITURE Report",ACHSEMON)

 +2        IF $DATA(DTOUT)

               GOTO K

           IF $DATA(DUOUT)

               GOTO BDT

REPORT    ; Select pt/comm/age.

 +1        WRITE !!,"Print Report by: ",!?3,"1. By Patient",!?3,"2. By Community of Residence",!?3,"3. By Age Grouping",!?3,"4. Totals Only",!?3,"5. By Tribe",!!?5,"Enter 1 to 5  1// "

 +2        DO READ^ACHSFU

 +3        IF $DATA(DTOUT)

               GOTO K

           IF $DATA(DUOUT)

               GOTO EDT

           IF Y?1"?".E

               GOTO REPORT

 +4        IF Y=""

               SET ACHSRPT=1

               GOTO TYPE

 +5        IF (Y<1)!(Y>5)

               WRITE !,*7

               GOTO REPORT

 +6        SET ACHSRPT=Y

TYPE      ; Select in/dent./out/all.

 +1        WRITE !!,"Want Expenditure Report by ",$SELECT(ACHSRPT=1:"Patient",ACHSRPT=2:"Community of Residence",1:"Age Grouping")," for: ",!!?5,"1.  Inpatient Services",!?5,"2.  Dental Services",!?5,"3.  Outpatient Serices",!?5,"4.  All Services",!

 +2        WRITE !,"Enter 1 thru 4   ALL// "

 +3        DO READ^ACHSFU

 +4        IF $DATA(DTOUT)

               GOTO K

           IF $DATA(DUOUT)

               GOTO REPORT

           IF Y?1"?".E

               GOTO TYPE

 +5        IF Y=""

               SET ACHSRPT1=4

               GOTO DEV

 +6        IF (Y<1)!(Y>4)

               WRITE !,*7

               GOTO TYPE

 +7        SET ACHSRPT1=Y

DEV       ; Select device.

 +1        SET %=$$PB^ACHS

 +2        IF %=U!$DATA(DTOUT)!$DATA(DUOUT)

               DO K

               QUIT 

 +3        IF %="B"

               DO VIEWR^XBLM($SELECT(ACHSRPT=3:"^ACHSC6D",1:"^ACHSC6C"))

               DO EN^XBVK("VALM")

               DO K

               QUIT 

 +4        SET %ZIS="OPQ"

 +5        DO ^%ZIS

 +6        IF POP

               DO HOME^%ZIS

               GOTO K

 +7        IF '$DATA(IO("Q"))

               IF ACHSRPT=3

                   GOTO ^ACHSC6D

               GOTO ^ACHSC6C

 +8        KILL IO("Q")

 +9        IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")

               WRITE *7,!,"Please queue to system printers."

               DO ^%ZISC

               GOTO DEV

 +10       SET ZTRTN=$SELECT(ACHSRPT=3:"^ACHSC6D",1:"^ACHSC6C")

           SET ZTIO=""

           SET ZTDESC="CHS EXPENDITURE REPORT #"_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)

           SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL

 +11       FOR %="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRPT","ACHSRPT1"

               SET ZTSAVE(%)=""

 +12       DO ^%ZTLOAD

 +13       IF '$DATA(ZTSK)

               GOTO DEV

K         ; Kill vars, close device, quit.

 +1        DO EN^XBVK("ACHS")

           DO ^ACHSVAR

 +2        KILL ZTIO,ZTSK

 +3        DO ^%ZISC

 +4        QUIT 

 +5       ;