ACHSC6P.m

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       ;