- 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 ;
