ACHSC6P ; IHS/ITSC/PMF - PRINT EXPENDITURE LIST BY PATIENT/COMMUNITY ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
;
S $P(^TMP("ACHSC6",$J,0),U,1,2)="^ACHSC6P"
I $D(ACHSQIO) F S IOP=ACHSQIO D ^%ZIS Q:'POP H 30
K ^TMP("ACHSC6",$J,0,"ACHSQIO")
S ACHSLOC=$$LOC^ACHS
S ACHSTY="CHS EXPENDITURE REPORT BY "_$S(ACHSRPT=2:"COMMUNITY",ACHSRPT=5:"TRIBE",1:"PATIENT")
D CITYST
S ACHST1=$$FMTE^XLFDT(ACHSBDT)_" Thru "_$$FMTE^XLFDT(ACHSEDT)
I '$D(ACHSTIME) D NOW^ACHS
U IO
D COMP
D BM^ACHSFU
Z ;
S ACHSPG=0
D HDR
D HDR2:ACHSRPT'=4
S (ACHSPTCT,ACHSTN43,ACHSESDA("T43"),ACHSTN57,ACHSTOA,ACHSTN64,ACHSESDA("T64"))=0
S (ACHST64("$"),ACHST57("$"),ACHST43("$"),ACHSGTOT("$"),ACHST3P("$"))=0
S ACHSNAME=""
A1 ;
S ACHSNAME=$O(^TMP("ACHSC6",$J,"P",ACHSNAME))
G A2:ACHSNAME=""
S ACHSPTCT=ACHSPTCT+1
S (DFN,ACHSCOMN,ACHSN43,ACHSN64,ACHSESDA(43),ACHSESDA(64))=""
S (ACHST43,ACHST64,ACHSN57,ACHST57,ACHST573,ACHST643,ACHST433)=""
I $D(^TMP("ACHSC6",$J,"P",ACHSNAME,43)) D
.S X=$G(^TMP("ACHSC6",$J,"P",ACHSNAME,43))
.S DFN=$P(X,U)
.S ACHSCOMN=$P(X,U,2)
.S ACHSN43=$P(X,U,3)
.S ACHSESDA(43)=$P(X,U,4)
.S ACHST43=$P(X,U,5)
.S ACHST433=$P(X,U,6)
;
I $D(^TMP("ACHSC6",$J,"P",ACHSNAME,64)) D
.S X=$G(^TMP("ACHSC6",$J,"P",ACHSNAME,64))
.S DFN=$P(X,U)
.S ACHSCOMN=$P(X,U,2)
.S ACHSN64=$P(X,U,3)
.S ACHSESDA(64)=$P(X,U,4)
.S ACHST64=$P(X,U,5)
.S ACHST643=$P(X,U,6)
;
I $D(^TMP("ACHSC6",$J,"P",ACHSNAME,57)) D
.S X=$G(^TMP("ACHSC6",$J,"P",ACHSNAME,57))
.S DFN=$P(X,U)
.S ACHSCOMN=$P(X,U,2)
.S ACHSN57=$P(X,U,3)
.S ACHST57=$P(X,U,5)
.S ACHST573=$P(X,U,6)
;
S ACHSTT3P=ACHST573+ACHST433+ACHST643
S ACHSTOA=ACHST43+ACHST64+ACHST57+ACHSTT3P
;
I ACHSRPT=1 S ACHSDOB="" I DFN S ACHSDOB=$P($G(^DPT(DFN,0)),U,3),ACHSDOB=$E(ACHSDOB,4,5)_"-"_$E(ACHSDOB,6,7)_"-"_($E(ACHSDOB,1,3)+1700)
WRITE ;
G:ACHSRPT=4 RPT4
I $Y>ACHSBM D RTRN^ACHS G A2:$G(ACHSQUIT) D HDR,HDR2
W !,$E(ACHSNAME_$J("",32),1,32),$J($FN(+ACHSN43,",",0),7),$J($FN(+ACHSESDA(43),",",0),8),$J($FN(ACHST43,",",2),12)
W $J($FN(+ACHSN64,",",0),7),$J($FN(+ACHSESDA(64),",",0),9),$J($FN(ACHST64,",",2),12),$J($FN(+ACHSN57,",",0),7)
W $J($FN(ACHST57,",",2),12),$J($FN(ACHSTT3P,",",2),12),$J($FN(ACHSTOA,",",2),14)
W:ACHSRPT=1 !,ACHSDOB," ",ACHSCOMN
RPT4 ;
S ACHSTN43=ACHSTN43+ACHSN43
S ACHSTN64=ACHSTN64+ACHSN64
S ACHSESDA("T43")=ACHSESDA("T43")+ACHSESDA(43)
S ACHSESDA("T64")=ACHSESDA("T64")+ACHSESDA(64)
S ACHST43("$")=ACHST43("$")+ACHST43
S ACHST64("$")=ACHST64("$")+ACHST64
S ACHST57("$")=ACHST57("$")+ACHST57
S ACHSTN57=ACHSTN57+ACHSN57
S ACHSGTOT("$")=ACHSGTOT("$")+ACHSTOA
S ACHST3P("$")=ACHST3P("$")+ACHSTT3P
G A1
;
A2 ;
I ACHSRPT'=4 D TOTAL^ACHSC6P2,RTRN^ACHS,HDR
D TOT^ACHSC6P2,RTRN^ACHS
W:$D(ACHS("PRINT",10)) @(ACHS("PRINT",10))
W @IOF
D ^%ZISC
G KILL^ACHSC6P2
;
HDR ;
S ACHSPG=ACHSPG+1
W @IOF,!!
I ACHSRPT'=4 W $$REPEAT^XLFSTR("*",132)
I ACHSRPT'=4 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 ",ACHSLOC," for Paid",!,"Authorizations issued Between ",ACHST1
Q
;
HDR2 ;
W !!,$S(ACHSRPT=2:"Community",ACHSRPT=5:"Tribe",1:"Patient"),?36,"#",?43,"# 43",?52,"Total",?63,"#",?71,"# 64 ",?82,"Total",?91,"#",?98,"Total",?112,"Total",?125,"Total",!
W:ACHSRPT=1 "Dob Community"
W ?35,"43's",?43,"Days",?52,"43 Dol",?62,"64's",?72,"Wkl",?82,"64 Dol",?90,"57's",?99,"57 Dol",?110,"3rd Party",?126,"Dol",!,$$REPEAT^XLFSTR("=",132)
Q
;
COMP ;EP. Compressed print for printer.
I $D(ACHSIO),ACHSIO=IO S X=132 X ^%ZOSF("RM")
K ACHS("PRINT")
S:$D(^%ZIS(2,IOST(0),12.1)) ACHS("PRINT",16)=$G(^%ZIS(2,IOST(0),12.1)) ; Code for compressed print.
I $P($G(^%ZIS(2,IOST(0),5)),U)'="" S ACHS("PRINT",10)=$P($G(^%ZIS(2,IOST(0),5)),U) ; Code for standard print.
I $D(ACHS("PRINT",16)),$D(ACHS("PRINT",10)) S IOP=IO_";132" U IO W @ACHS("PRINT",16) ; Set for compressed print.
Q
;
CITYST ;EP.
S ACHSCITY=""
I $D(^AUTTLOC(DUZ(2),0)) S ACHSCITY=$P($G(^AUTTLOC(DUZ(2),0)),U,13)_", "_$P($G(^DIC(5,+$P($G(^AUTTLOC(DUZ(2),0)),U,14),0)),U) Q
I $D(^DIC(4,DUZ(2),1))#2 S ACHSCITY=$P($G(^DIC(4,DUZ(2),1)),U,3)_", "_$P($G(^DIC(5,+$P($G(^DIC(4,DUZ(2),0)),U,2),0)),U)
Q
;
ACHSC6P ; IHS/ITSC/PMF - PRINT EXPENDITURE LIST BY PATIENT/COMMUNITY ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 ;
+4 SET $PIECE(^TMP("ACHSC6",$JOB,0),U,1,2)="^ACHSC6P"
+5 IF $DATA(ACHSQIO)
FOR
SET IOP=ACHSQIO
DO ^%ZIS
IF 'POP
QUIT
HANG 30
+6 KILL ^TMP("ACHSC6",$JOB,0,"ACHSQIO")
+7 SET ACHSLOC=$$LOC^ACHS
+8 SET ACHSTY="CHS EXPENDITURE REPORT BY "_$SELECT(ACHSRPT=2:"COMMUNITY",ACHSRPT=5:"TRIBE",1:"PATIENT")
+9 DO CITYST
+10 SET ACHST1=$$FMTE^XLFDT(ACHSBDT)_" Thru "_$$FMTE^XLFDT(ACHSEDT)
+11 IF '$DATA(ACHSTIME)
DO NOW^ACHS
+12 USE IO
+13 DO COMP
+14 DO BM^ACHSFU
Z ;
+1 SET ACHSPG=0
+2 DO HDR
+3 IF ACHSRPT'=4
DO HDR2
+4 SET (ACHSPTCT,ACHSTN43,ACHSESDA("T43"),ACHSTN57,ACHSTOA,ACHSTN64,ACHSESDA("T64"))=0
+5 SET (ACHST64("$"),ACHST57("$"),ACHST43("$"),ACHSGTOT("$"),ACHST3P("$"))=0
+6 SET ACHSNAME=""
A1 ;
+1 SET ACHSNAME=$ORDER(^TMP("ACHSC6",$JOB,"P",ACHSNAME))
+2 IF ACHSNAME=""
GOTO A2
+3 SET ACHSPTCT=ACHSPTCT+1
+4 SET (DFN,ACHSCOMN,ACHSN43,ACHSN64,ACHSESDA(43),ACHSESDA(64))=""
+5 SET (ACHST43,ACHST64,ACHSN57,ACHST57,ACHST573,ACHST643,ACHST433)=""
+6 IF $DATA(^TMP("ACHSC6",$JOB,"P",ACHSNAME,43))
Begin DoDot:1
+7 SET X=$GET(^TMP("ACHSC6",$JOB,"P",ACHSNAME,43))
+8 SET DFN=$PIECE(X,U)
+9 SET ACHSCOMN=$PIECE(X,U,2)
+10 SET ACHSN43=$PIECE(X,U,3)
+11 SET ACHSESDA(43)=$PIECE(X,U,4)
+12 SET ACHST43=$PIECE(X,U,5)
+13 SET ACHST433=$PIECE(X,U,6)
End DoDot:1
+14 ;
+15 IF $DATA(^TMP("ACHSC6",$JOB,"P",ACHSNAME,64))
Begin DoDot:1
+16 SET X=$GET(^TMP("ACHSC6",$JOB,"P",ACHSNAME,64))
+17 SET DFN=$PIECE(X,U)
+18 SET ACHSCOMN=$PIECE(X,U,2)
+19 SET ACHSN64=$PIECE(X,U,3)
+20 SET ACHSESDA(64)=$PIECE(X,U,4)
+21 SET ACHST64=$PIECE(X,U,5)
+22 SET ACHST643=$PIECE(X,U,6)
End DoDot:1
+23 ;
+24 IF $DATA(^TMP("ACHSC6",$JOB,"P",ACHSNAME,57))
Begin DoDot:1
+25 SET X=$GET(^TMP("ACHSC6",$JOB,"P",ACHSNAME,57))
+26 SET DFN=$PIECE(X,U)
+27 SET ACHSCOMN=$PIECE(X,U,2)
+28 SET ACHSN57=$PIECE(X,U,3)
+29 SET ACHST57=$PIECE(X,U,5)
+30 SET ACHST573=$PIECE(X,U,6)
End DoDot:1
+31 ;
+32 SET ACHSTT3P=ACHST573+ACHST433+ACHST643
+33 SET ACHSTOA=ACHST43+ACHST64+ACHST57+ACHSTT3P
+34 ;
+35 IF ACHSRPT=1
SET ACHSDOB=""
IF DFN
SET ACHSDOB=$PIECE($GET(^DPT(DFN,0)),U,3)
SET ACHSDOB=$EXTRACT(ACHSDOB,4,5)_"-"_$EXTRACT(ACHSDOB,6,7)_"-"_($EXTRACT(ACHSDOB,1,3)+1700)
WRITE ;
+1 IF ACHSRPT=4
GOTO RPT4
+2 IF $Y>ACHSBM
DO RTRN^ACHS
IF $GET(ACHSQUIT)
GOTO A2
DO HDR
DO HDR2
+3 WRITE !,$EXTRACT(ACHSNAME_$JUSTIFY("",32),1,32),$JUSTIFY($FNUMBER(+ACHSN43,",",0),7),$JUSTIFY($FNUMBER(+ACHSESDA(43),",",0),8),$JUSTIFY($FNUMBER(ACHST43,",",2),12)
+4 WRITE $JUSTIFY($FNUMBER(+ACHSN64,",",0),7),$JUSTIFY($FNUMBER(+ACHSESDA(64),",",0),9),$JUSTIFY($FNUMBER(ACHST64,",",2),12),$JUSTIFY($FNUMBER(+ACHSN57,",",0),7)
+5 WRITE $JUSTIFY($FNUMBER(ACHST57,",",2),12),$JUSTIFY($FNUMBER(ACHSTT3P,",",2),12),$JUSTIFY($FNUMBER(ACHSTOA,",",2),14)
+6 IF ACHSRPT=1
WRITE !,ACHSDOB," ",ACHSCOMN
RPT4 ;
+1 SET ACHSTN43=ACHSTN43+ACHSN43
+2 SET ACHSTN64=ACHSTN64+ACHSN64
+3 SET ACHSESDA("T43")=ACHSESDA("T43")+ACHSESDA(43)
+4 SET ACHSESDA("T64")=ACHSESDA("T64")+ACHSESDA(64)
+5 SET ACHST43("$")=ACHST43("$")+ACHST43
+6 SET ACHST64("$")=ACHST64("$")+ACHST64
+7 SET ACHST57("$")=ACHST57("$")+ACHST57
+8 SET ACHSTN57=ACHSTN57+ACHSN57
+9 SET ACHSGTOT("$")=ACHSGTOT("$")+ACHSTOA
+10 SET ACHST3P("$")=ACHST3P("$")+ACHSTT3P
+11 GOTO A1
+12 ;
A2 ;
+1 IF ACHSRPT'=4
DO TOTAL^ACHSC6P2
DO RTRN^ACHS
DO HDR
+2 DO TOT^ACHSC6P2
DO RTRN^ACHS
+3 IF $DATA(ACHS("PRINT",10))
WRITE @(ACHS("PRINT",10))
+4 WRITE @IOF
+5 DO ^%ZISC
+6 GOTO KILL^ACHSC6P2
+7 ;
HDR ;
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF,!!
+3 IF ACHSRPT'=4
WRITE $$REPEAT^XLFSTR("*",132)
+4 IF ACHSRPT'=4
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)
+5 WRITE !!,$SELECT(ACHSRPT1=1:"Inpatient",ACHSRPT1=3:"Outpatient",ACHSRPT1=2:"Dental",1:"All")
WRITE " Expenditures for ",ACHSLOC," for Paid",!,"Authorizations issued Between ",ACHST1
+6 QUIT
+7 ;
HDR2 ;
+1 WRITE !!,$SELECT(ACHSRPT=2:"Community",ACHSRPT=5:"Tribe",1:"Patient"),?36,"#",?43,"# 43",?52,"Total",?63,"#",?71,"# 64 ",?82,"Total",?91,"#",?98,"Total",?112,"Total",?125,"Total",!
+2 IF ACHSRPT=1
WRITE "Dob Community"
+3 WRITE ?35,"43's",?43,"Days",?52,"43 Dol",?62,"64's",?72,"Wkl",?82,"64 Dol",?90,"57's",?99,"57 Dol",?110,"3rd Party",?126,"Dol",!,$$REPEAT^XLFSTR("=",132)
+4 QUIT
+5 ;
COMP ;EP. Compressed print for printer.
+1 IF $DATA(ACHSIO)
IF ACHSIO=IO
SET X=132
XECUTE ^%ZOSF("RM")
+2 KILL ACHS("PRINT")
+3 ; Code for compressed print.
IF $DATA(^%ZIS(2,IOST(0),12.1))
SET ACHS("PRINT",16)=$GET(^%ZIS(2,IOST(0),12.1))
+4 ; Code for standard print.
IF $PIECE($GET(^%ZIS(2,IOST(0),5)),U)'=""
SET ACHS("PRINT",10)=$PIECE($GET(^%ZIS(2,IOST(0),5)),U)
+5 ; Set for compressed print.
IF $DATA(ACHS("PRINT",16))
IF $DATA(ACHS("PRINT",10))
SET IOP=IO_";132"
USE IO
WRITE @ACHS("PRINT",16)
+6 QUIT
+7 ;
CITYST ;EP.
+1 SET ACHSCITY=""
+2 IF $DATA(^AUTTLOC(DUZ(2),0))
SET ACHSCITY=$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,13)_", "_$PIECE($GET(^DIC(5,+$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,14),0)),U)
QUIT
+3 IF $DATA(^DIC(4,DUZ(2),1))#2
SET ACHSCITY=$PIECE($GET(^DIC(4,DUZ(2),1)),U,3)_", "_$PIECE($GET(^DIC(5,+$PIECE($GET(^DIC(4,DUZ(2),0)),U,2),0)),U)
+4 QUIT
+5 ;
