ACHSC6P2.m

ACHSC6P2 ; IHS/ITSC/PMF - PRINT EXPENDITURE REPORTS TOTALS ;  [ 10/16/2001   8:16 AM ]

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

TOT ;EP.

 S ACHS="",$P(ACHS,".",31)=""

 W !!,"Total ",$S(ACHSRPT=2:"Communitie",ACHSRPT=5:"Tribe",1:"Patient"),"s for Period",$E(ACHS,1,50-$X-$L(ACHSPTCT)),ACHSPTCT

 W !!,"Total 43 Documents for period",$E(ACHS,1,50-$X-$L(ACHSTN43)),ACHSTN43,!,"Total 43 Estimated Days of care",$E(ACHS,1,50-$X-$L(ACHSESDA("T43"))),ACHSESDA("T43")

 S X=ACHST43("$")

 D FMT

 W !,"Total 43 Dollars",$E(ACHS,1,50-$X-$L(X)),X,!

 W !,"Total 64 Documents for period",$E(ACHS,1,50-$X-$L(ACHSTN64)),ACHSTN64

 W !,"Total 64 Estimated Days of Care",$E(ACHS,1,50-$X-$L(ACHSESDA("T64"))),ACHSESDA("T64"),!

 S X=ACHST64("$")

 D FMT

 W "Total 64 Dollars",$E(ACHS,1,50-$X-$L(X)),X

 W !!,"Total 57 Documents for period",$E(ACHS,1,50-$X-$L(ACHSTN57)),ACHSTN57,!

 S X=ACHST57("$")

 D FMT

 W "Total 57 Dollars",$E(ACHS,1,50-$X-$L(X)),X

 S X=ACHST3P("$") D FMT W !!,"Total Third Party Payments",$E(ACHS,1,50-$X-$L(X)),X,!!

 S X=ACHSGTOT("$") D FMT W "Total Dollars for Period",$E(ACHS,1,50-$X-$L(X)),X

 Q

 ;

TOTAL ;EP.

 N X

 W !,$$REPEAT^XLFSTR("-",132)

 S X=$J($FN(ACHSTN43,",",0),7)_$J($FN(ACHSESDA("T43"),",",0),8)_$J($FN(ACHST43("$"),",",2),12)_$J($FN(ACHSTN64,",",0),7)_$J($FN(ACHSESDA("T64"),",",0),9)

 S X=X_$J($FN(ACHST64("$"),",",2),12)_$J($FN(ACHSTN57,",",0),7)_$J($FN(ACHST57("$"),",",2),12)_$J($FN(ACHST3P("$"),",",2),12)_$J($FN(ACHSGTOT("$"),",",2),14)

 W !,"Total",?(132-$L(X)),X

 Q

 ;

KILL ;EP.

 K A,ACHS,ACHSBM,ACHSCITY,ACHSEMON,ACHSMON,ACHSTIME,ACHSTY,ACHSBDT

 K ACHSCAN,ACHSCOMM,ACHSCOMN,ACHSDOB,ACHSEDT,ACHSGRP,ACHSNAME,ACHSPG,ACHSPTCT,ACHSRPT,ACHSRPT1,ACHSSEX,ACHST2,ACHST3P,ACHSTAO,ACHSGTOT,ACHST1,ACHSTRDT

 K DFN,DOC,ACHSESDA,ACHSN43,ACHSN57,ACHSN64,ACHSNP,ACHSPA,ACHSP3B,ACHSPT

 K T,ACHST3B,ACHST3P,ACHST43,ACHST433,ACHST57,ACHST573,ACHST64,ACHST643,ACHSTN43,ACHSTN57

 K ACHSTN64,ACHSTNP,ACHSTOA,ACHST43,ACHST57,ACHST64,ACHSTO43,ACHSTO57,ACHSTO64,ACHSTOAA,ACHSTOT,ACHSTOTT,ACHSTT3B,ACHSTT3P,ACHSTWKL,ACHSTY,ACHSTOS,ZTSK

 Q

 ;

FMT ;

 S:'$D(X2) X2="2$"

 S:'$D(X3) X3=0

 D COMMA^%DTC

 S:'X3 X=$P(X," ")

 K X2,X3

 Q

 ;

ACHSC6P2  ; IHS/ITSC/PMF - PRINT EXPENDITURE REPORTS TOTALS ;  [ 10/16/2001   8:16 AM ]

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

TOT       ;EP.

 +1        SET ACHS=""

           SET $PIECE(ACHS,".",31)=""

 +2        WRITE !!,"Total ",$SELECT(ACHSRPT=2:"Communitie",ACHSRPT=5:"Tribe",1:"Patient"),"s for Period",$EXTRACT(ACHS,1,50-$X-$LENGTH(ACHSPTCT)),ACHSPTCT

 +3        WRITE !!,"Total 43 Documents for period",$EXTRACT(ACHS,1,50-$X-$LENGTH(ACHSTN43)),ACHSTN43,!,"Total 43 Estimated Days of care",$EXTRACT(ACHS,1,50-$X-$LENGTH(ACHSESDA("T43"))),ACHSESDA("T43")

 +4        SET X=ACHST43("$")

 +5        DO FMT

 +6        WRITE !,"Total 43 Dollars",$EXTRACT(ACHS,1,50-$X-$LENGTH(X)),X,!

 +7        WRITE !,"Total 64 Documents for period",$EXTRACT(ACHS,1,50-$X-$LENGTH(ACHSTN64)),ACHSTN64

 +8        WRITE !,"Total 64 Estimated Days of Care",$EXTRACT(ACHS,1,50-$X-$LENGTH(ACHSESDA("T64"))),ACHSESDA("T64"),!

 +9        SET X=ACHST64("$")

 +10       DO FMT

 +11       WRITE "Total 64 Dollars",$EXTRACT(ACHS,1,50-$X-$LENGTH(X)),X

 +12       WRITE !!,"Total 57 Documents for period",$EXTRACT(ACHS,1,50-$X-$LENGTH(ACHSTN57)),ACHSTN57,!

 +13       SET X=ACHST57("$")

 +14       DO FMT

 +15       WRITE "Total 57 Dollars",$EXTRACT(ACHS,1,50-$X-$LENGTH(X)),X

 +16       SET X=ACHST3P("$")

           DO FMT

           WRITE !!,"Total Third Party Payments",$EXTRACT(ACHS,1,50-$X-$LENGTH(X)),X,!!

 +17       SET X=ACHSGTOT("$")

           DO FMT

           WRITE "Total Dollars for Period",$EXTRACT(ACHS,1,50-$X-$LENGTH(X)),X

 +18       QUIT 

 +19      ;

TOTAL     ;EP.

 +1        NEW X

 +2        WRITE !,$$REPEAT^XLFSTR("-",132)

 +3        SET X=$JUSTIFY($FNUMBER(ACHSTN43,",",0),7)_$JUSTIFY($FNUMBER(ACHSESDA("T43"),",",0),8)_$JUSTIFY($FNUMBER(ACHST43("$"),",",2),12)_$JUSTIFY($FNUMBER(ACHSTN64,",",0),7)_$JUSTIFY($FNUMBER(ACHSESDA("T64"),",",0),9)

 +4        SET X=X_$JUSTIFY($FNUMBER(ACHST64("$"),",",2),12)_$JUSTIFY($FNUMBER(ACHSTN57,",",0),7)_$JUSTIFY($FNUMBER(ACHST57("$"),",",2),12)_$JUSTIFY($FNUMBER(ACHST3P("$"),",",2),12)_$JUSTIFY($FNUMBER(ACHSGTOT("$"),",",2),14)

 +5        WRITE !,"Total",?(132-$LENGTH(X)),X

 +6        QUIT 

 +7       ;

KILL      ;EP.

 +1        KILL A,ACHS,ACHSBM,ACHSCITY,ACHSEMON,ACHSMON,ACHSTIME,ACHSTY,ACHSBDT

 +2        KILL ACHSCAN,ACHSCOMM,ACHSCOMN,ACHSDOB,ACHSEDT,ACHSGRP,ACHSNAME,ACHSPG,ACHSPTCT,ACHSRPT,ACHSRPT1,ACHSSEX,ACHST2,ACHST3P,ACHSTAO,ACHSGTOT,ACHST1,ACHSTRDT

 +3        KILL DFN,DOC,ACHSESDA,ACHSN43,ACHSN57,ACHSN64,ACHSNP,ACHSPA,ACHSP3B,ACHSPT

 +4        KILL T,ACHST3B,ACHST3P,ACHST43,ACHST433,ACHST57,ACHST573,ACHST64,ACHST643,ACHSTN43,ACHSTN57

 +5        KILL ACHSTN64,ACHSTNP,ACHSTOA,ACHST43,ACHST57,ACHST64,ACHSTO43,ACHSTO57,ACHSTO64,ACHSTOAA,ACHSTOT,ACHSTOTT,ACHSTT3B,ACHSTT3P,ACHSTWKL,ACHSTY,ACHSTOS,ZTSK

 +6        QUIT 

 +7       ;

FMT       ;

 +1        IF '$DATA(X2)

               SET X2="2$"

 +2        IF '$DATA(X3)

               SET X3=0

 +3        DO COMMA^%DTC

 +4        IF 'X3

               SET X=$PIECE(X," ")

 +5        KILL X2,X3

 +6        QUIT 

 +7       ;