Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSC6P2

ACHSC6P2.m

Go to the documentation of this file.
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
 ;