ACHSC6P1.m

ACHSC6P1 ; IHS/ITSC/PMF - PRINT EXPENDITURE REPORT BY AGE GROUP ;   [ 10/16/2001   8:16 AM ]

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

 ;

 S $P(^TMP("ACHSC6",$J,0),U,1,2)="^ACHSC6P1"

 I $D(ACHSQIO) F  S IOP=ACHSQIO D ^%ZIS Q:'POP  H 30

 K ^TMP("ACHSC6",$J,0,"ACHSQIO")

 U IO

 D BM^ACHSFU

 D LINES^ACHSFU

 D NOW^ACHS

 D COMP^ACHSC6P

 S (ACHSPG,ACHSTNP,ACHSTN43,ACHSTN64,ACHSESDA("T"),ACHSTWKL,ACHSTO43,ACHSTO64,ACHSTO57,ACHSTOA,ACHSTN57,ACHSTT3B,ACHSTOTT)=0

 S ACHS("*")=ACHS("*")_$E(ACHS("*"),1,53)

 S ACHS("=")=ACHS("=")_$E(ACHS("="),1,53)

 S ACHS("-")=ACHS("-")_$E(ACHS("-"),1,53)

 S ACHSLOC=$$LOC^ACHS,ACHSTY=$S(ACHSRPT=2:"CHS EXPENDITURE REPORT BY COMMUNITY",ACHSRPT=1:"CHS EXPENDITURE REPORT BY PATIENT ",1:"EXPENDITURE REPORT BY AGE GROUPS")

 D CITYST^ACHSC6P

 S ACHST1=$$FMTE^XLFDT(ACHSBDT)_" Thru "_$$FMTE^XLFDT(ACHSEDT)

 D HDR

 S ACHSGRP=""

A1 ;

 S ACHSGRP=$O(^TMP("ACHSC6",$J,"P",ACHSGRP))

 G TOT:ACHSGRP=""

 S ACHSSEX=""

A2 ;

 S ACHSSEX=$O(^TMP("ACHSC6",$J,"P",ACHSGRP,ACHSSEX))

 G A1:ACHSSEX="" S X=$G(^TMP("ACHSC6",$J,"P",ACHSGRP,ACHSSEX))

 S ACHST2=$S(ACHSGRP="A":"< 1",ACHSGRP="B":"1-4",ACHSGRP="C":"5-9",ACHSGRP="D":"10-14",ACHSGRP="E":"15-19",ACHSGRP="F":"20-24",ACHSGRP="G":"25-29",ACHSGRP="H":"30-39",ACHSGRP="I":"40-54",ACHSGRP="J":"55-64",1:" 65+")

 S ACHSNP=$P(X,U)

 S ACHSN43=$P(X,U,2)

 S ACHSESDA=$P(X,U,3)

 S ACHST43=$P(X,U,4)

 S ACHSN64=$P(X,U,5)

 S ACHSWKL=$P(X,U,6)

 S ACHST64=$P(X,U,7)

 S ACHSN57=$P(X,U,8)

 S ACHST57=$P(X,U,9)

 S ACHSTOA=$P(X,U,10)

 S ACHST3B=$P(X,U,11)

 S ACHSTOT=$P(X,U,12)

 I $Y>ACHSBM D RTRN^ACHS G TOT:$G(ACHSQUIT) D HDR

 W !,$J(ACHST2,5),?9,ACHSSEX,?16,$J(+ACHSNP,3),?25,$J(+ACHSN43,3),?35,$J(+ACHSESDA,3),?44,$J(ACHST43,8,2),?57,$J(+ACHSN64,3),?67,$J(+ACHSWKL,3),?75,$J(ACHST64,8,2),?89,$J(+ACHSN57,3),?96,$J(ACHST57,8,2),?109,$J(ACHST3B,8,2),?120,$J(ACHSTOT,12,2)

 S ACHSTNP=ACHSTNP+ACHSNP

 S ACHSTN43=ACHSTN43+ACHSN43

 S ACHSTN64=ACHSTN64+ACHSN64

 S ACHSESDA("T")=ACHSESDA("T")+ACHSESDA

 S ACHSTWKL=ACHSTWKL+ACHSWKL

 S ACHSTO43=ACHSTO43+ACHST43

 S ACHSTO64=ACHSTO64+ACHST64

 S ACHSTO57=ACHSTO57+ACHST57

 S ACHSTN57=ACHSTN57+ACHSN57

 S ACHSTOTT=ACHSTOTT+ACHSTOT

 S ACHSTT3B=ACHSTT3B+ACHST3B

 G A2

 ;

HDR ;

 S ACHSPG=ACHSPG+1

 W @IOF,!!,$$REPEAT^XLFSTR("*",132)

 W !,$$C^XBFUNC(ACHSLOC,132),!,ACHSTIME,?132-$L(ACHSTY)/2,ACHSTY,?122,"Page:",$J(ACHSPG,4),!,$$C^XBFUNC(ACHSCITY,132),!,$$C^XBFUNC(ACHST1,132),!,$$REPEAT^XLFSTR("*",132)

 W !!,$S(ACHSRPT1=1:"Inpatient",ACHSRPT1=3:"Outpatient",ACHSRPT1=2:"Dental",1:"All") W " Expenditures for ",$$LOC^ACHS," for Document",!,"Authorizations issued Between ",ACHST1

 W !!?1,"Age",?8,"Sex",?16,"# of",?27,"#",?35,"# 43",?45,"Total",?58,"#",?66,"# 64 ",?78,"Total",?89,"#",?97,"Total",?111,"Total",?125,"Total"

 W !,"Group",?16,"Pts",?26,"43's",?35,"Days",?45,"43 Dol",?57,"64's",?67,"Wkl",?78,"64 Dol",?88,"57's",?97,"57 Dol",?110,"3rd Party",?126,"Dol"

 W !,ACHS("=")

 Q

 ;

TOT ;

 W !!,ACHS("=")

 W !,"Totals",?16,$J(ACHSTNP,3),?25,$J(+ACHSTN43,3),?35,$J(+ACHSESDA("T"),3),?44,$J(ACHSTO43,8,2),?57,$J(+ACHSTN64,3),?67,$J(+ACHSTWKL,3),?75,$J(ACHSTO64,8,2),?89,$J(+ACHSTN57,3),?96,$J(ACHSTO57,8,2),?109,$J(ACHSTT3B,8,2),?123,$J(ACHSTOTT,9,2)

 D RTRN^ACHS

 W @IOF

 D ^%ZISC

 D KILL^ACHSC6P2

 Q

 ;

ACHSC6P1  ; IHS/ITSC/PMF - PRINT EXPENDITURE REPORT BY AGE GROUP ;   [ 10/16/2001   8:16 AM ]

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

 +2       ;

 +3        SET $PIECE(^TMP("ACHSC6",$JOB,0),U,1,2)="^ACHSC6P1"

 +4        IF $DATA(ACHSQIO)

               FOR 

                   SET IOP=ACHSQIO

                   DO ^%ZIS

                   IF 'POP

                       QUIT 

                   HANG 30

 +5        KILL ^TMP("ACHSC6",$JOB,0,"ACHSQIO")

 +6        USE IO

 +7        DO BM^ACHSFU

 +8        DO LINES^ACHSFU

 +9        DO NOW^ACHS

 +10       DO COMP^ACHSC6P

 +11       SET (ACHSPG,ACHSTNP,ACHSTN43,ACHSTN64,ACHSESDA("T"),ACHSTWKL,ACHSTO43,ACHSTO64,ACHSTO57,ACHSTOA,ACHSTN57,ACHSTT3B,ACHSTOTT)=0

 +12       SET ACHS("*")=ACHS("*")_$EXTRACT(ACHS("*"),1,53)

 +13       SET ACHS("=")=ACHS("=")_$EXTRACT(ACHS("="),1,53)

 +14       SET ACHS("-")=ACHS("-")_$EXTRACT(ACHS("-"),1,53)

 +15       SET ACHSLOC=$$LOC^ACHS

           SET ACHSTY=$SELECT(ACHSRPT=2:"CHS EXPENDITURE REPORT BY COMMUNITY",ACHSRPT=1:"CHS EXPENDITURE REPORT BY PATIENT ",1:"EXPENDITURE REPORT BY AGE GROUPS")

 +16       DO CITYST^ACHSC6P

 +17       SET ACHST1=$$FMTE^XLFDT(ACHSBDT)_" Thru "_$$FMTE^XLFDT(ACHSEDT)

 +18       DO HDR

 +19       SET ACHSGRP=""

A1        ;

 +1        SET ACHSGRP=$ORDER(^TMP("ACHSC6",$JOB,"P",ACHSGRP))

 +2        IF ACHSGRP=""

               GOTO TOT

 +3        SET ACHSSEX=""

A2        ;

 +1        SET ACHSSEX=$ORDER(^TMP("ACHSC6",$JOB,"P",ACHSGRP,ACHSSEX))

 +2        IF ACHSSEX=""

               GOTO A1

           SET X=$GET(^TMP("ACHSC6",$JOB,"P",ACHSGRP,ACHSSEX))

 +3        SET ACHST2=$SELECT(ACHSGRP="A":"< 1",ACHSGRP="B":"1-4",ACHSGRP="C":"5-9",ACHSGRP="D":"10-14",ACHSGRP="E":"15-19",ACHSGRP="F":"20-24",ACHSGRP="G":"25-29",ACHSGRP="H":"30-39",ACHSGRP="I":"40-54",ACHSGRP="J":"55-64",1:" 65+")

 +4        SET ACHSNP=$PIECE(X,U)

 +5        SET ACHSN43=$PIECE(X,U,2)

 +6        SET ACHSESDA=$PIECE(X,U,3)

 +7        SET ACHST43=$PIECE(X,U,4)

 +8        SET ACHSN64=$PIECE(X,U,5)

 +9        SET ACHSWKL=$PIECE(X,U,6)

 +10       SET ACHST64=$PIECE(X,U,7)

 +11       SET ACHSN57=$PIECE(X,U,8)

 +12       SET ACHST57=$PIECE(X,U,9)

 +13       SET ACHSTOA=$PIECE(X,U,10)

 +14       SET ACHST3B=$PIECE(X,U,11)

 +15       SET ACHSTOT=$PIECE(X,U,12)

 +16       IF $Y>ACHSBM

               DO RTRN^ACHS

               IF $GET(ACHSQUIT)

                   GOTO TOT

               DO HDR

 +17      WRITE !,$JUSTIFY(ACHST2,5),?9,ACHSSEX,?16,...

          WRITE $JUSTIFY(+ACHSNP,3),?25,$JUSTIFY(+ACHSN43,3),?35,$JUSTIFY(+ACHSESDA,3),?44,$JUSTIFY(ACHST43,8,2),?57,$JUSTIFY(+ACHSN64,3),?67,$JUSTIFY(+ACHSWKL,3),?75,...

           ... $JUSTIFY(ACHST64,8,2),?89,$JUSTIFY(+ACHSN57,3),?96,$JUSTIFY(ACHST57,8,2),?109,$JUSTIFY(ACHST3B,8,2),?120,$JUSTIFY(ACHSTOT,12,2)

 +18       SET ACHSTNP=ACHSTNP+ACHSNP

 +19       SET ACHSTN43=ACHSTN43+ACHSN43

 +20       SET ACHSTN64=ACHSTN64+ACHSN64

 +21       SET ACHSESDA("T")=ACHSESDA("T")+ACHSESDA

 +22       SET ACHSTWKL=ACHSTWKL+ACHSWKL

 +23       SET ACHSTO43=ACHSTO43+ACHST43

 +24       SET ACHSTO64=ACHSTO64+ACHST64

 +25       SET ACHSTO57=ACHSTO57+ACHST57

 +26       SET ACHSTN57=ACHSTN57+ACHSN57

 +27       SET ACHSTOTT=ACHSTOTT+ACHSTOT

 +28       SET ACHSTT3B=ACHSTT3B+ACHST3B

 +29       GOTO A2

 +30      ;

HDR       ;

 +1        SET ACHSPG=ACHSPG+1

 +2        WRITE @IOF,!!,$$REPEAT^XLFSTR("*",132)

 +3        WRITE !,$$C^XBFUNC(ACHSLOC,132),!,ACHSTIME,?132-$LENGTH(ACHSTY)/2,ACHSTY,?122,"Page:",$JUSTIFY(ACHSPG,4),!,$$C^XBFUNC(ACHSCITY,132),!,$$C^XBFUNC(ACHST1,132),!,$$REPEAT^XLFSTR("*",132)

 +4        WRITE !!,$SELECT(ACHSRPT1=1:"Inpatient",ACHSRPT1=3:"Outpatient",ACHSRPT1=2:"Dental",1:"All")

           WRITE " Expenditures for ",$$LOC^ACHS," for Document",!,"Authorizations issued Between ",ACHST1

 +5        WRITE !!?1,"Age",?8,"Sex",?16,"# of",?27,"#",?35,"# 43",?45,"Total",?58,"#",?66,"# 64 ",?78,"Total",?89,"#",?97,"Total",?111,"Total",?125,"Total"

 +6        WRITE !,"Group",?16,"Pts",?26,"43's",?35,"Days",?45,"43 Dol",?57,"64's",?67,"Wkl",?78,"64 Dol",?88,"57's",?97,"57 Dol",?110,"3rd Party",?126,"Dol"

 +7        WRITE !,ACHS("=")

 +8        QUIT 

 +9       ;

TOT       ;

 +1        WRITE !!,ACHS("=")

 +2       WRITE !,"Totals",?16,$JUSTIFY(ACHSTNP,3),?25,...

          WRITE $JUSTIFY(+ACHSTN43,3),?35,$JUSTIFY(+ACHSESDA("T"),3),?44,$JUSTIFY(ACHSTO43,8,2),?57,$JUSTIFY(+ACHSTN64,3),?67,$JUSTIFY(+ACHSTWKL,3),?75,$JUSTIFY(ACHSTO64,8,2),?89,$JUSTIFY(+ACHSTN57,3),?96,...

           ... $JUSTIFY(ACHSTO57,8,2),?109,$JUSTIFY(ACHSTT3B,8,2),?123,$JUSTIFY(ACHSTOTT,9,2)

 +3        DO RTRN^ACHS

 +4        WRITE @IOF

 +5        DO ^%ZISC

 +6        DO KILL^ACHSC6P2

 +7        QUIT 

 +8       ;