ACHSEOBI.m

ACHSEOBI ; IHS/ITSC/PMF - EOBR RECONCILIATION ;  [ 10/16/2001   8:16 AM ]

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

 ;

 S (ACHSFY,ACHSCNT,ACHSSUM,ACHSBBAL,ACHSEBAL,ACHSTOT,ACHSPG)=0,ACHSIO=IO,ACHSLOC=$$LOC^ACHS

 D NOW^ACHS

BEGIN ; Main process loop.

 S ACHSFY=$O(^ACHSEOBR("ACHSSUM",ACHSFY))

 G END:ACHSFY=""

 D SUMMARY,REPORT

 G BEGIN

 ;

END ; Kill vars, close device, quit.

 K ACHS1,ACHSACT0,ACHSFY,ACHSSUM,ACHSBBAL,ACHSEBAL,ACHSREG,ACHSTOT,ACHSADJ,ACHSAMT,ACHSDCR

 D ^%ZISC

 Q

 ;

SUMMARY ;

 D HDR,HDR3

 W !!

 S ACHSTOT(ACHSFY,"TOTALS")=0

 F ACHSTYPE="PAYMENTS","ADJUSTMENTS","INTERIM PAYMENTS" D

 . I $D(^ACHSEOBR("ACHSTOT",ACHSFY,ACHSTYPE)) D SB2 D

 .. W !?5,ACHSTYPE," DOCUMENTS",?46,$J(ACHS1,5),?57,$J(ACHS,11)

 .. I ACHSTYPE="INTERIM PAYMENTS" W "***" S ACHSIP=1

 ..Q

 .Q

 W !?46,"-----",?60,"--------------"

 S X=$P(ACHSTOT(ACHSFY,"TOTALS"),U)

 D COMMA^%DTC

 W !!?5,"TOTALS",?46,$J($P(ACHSTOT(ACHSFY,"TOTALS"),U,2),5),?57,$J(X,11)

 W:$D(ACHSIP) !!?5,"*** Interim Payments Not Reflected In Totals"

 K ACHSIP

 Q

 ;

REPORT ;

 D HDR,HDR1,HDR2

 S ACHSACTN=$G(^ACHS(9,DUZ(2),"RN")),X2=2,X3=12

 S ACHSRTOT(ACHSFY,"BBAL")=0,ACHSRTOT(ACHSFY,"+")=0,ACHSRTOT(ACHSFY,"-")=0,ACHSRTOT(ACHSFY,"TOT")=0,ACHSRTOT(ACHSFY,"RTOT")=0

 F I=1:1:7 S $P(^ACHSEOBR("ACHSSUM",ACHSFY,"TOT"),U,I)=$P(^ACHSEOBR("ACHSSUM",ACHSFY,"+"),U,I)+$P(^ACHSEOBR("ACHSSUM",ACHSFY,"-"),U,I)

 F K=1:1:7 W $E($P(ACHSACTN,U,K),1,18),?18 D SB1 W:K<7 !

 W !,"----------------"

 D HDR2

 W "TOTAL",?18 F I="BBAL","+","-","TOT"

 S X=ACHSRTOT(ACHSFY,I)

 D FMT

 S X=ACHSRTOT(ACHSFY,"RTOT")

 D FMT

 S ACHSACT0=$P(^ACHS(9,DUZ(2),"FY",ACHSFY,0),U,3)

 S X2="2$",X3=18,X=$P(^ACHS(9,DUZ(2),"FY",ACHSFY,0),U,2),ACHSACT1=X

 D COMMA^%DTC

 W !!!!!,"YEAR TO DATE ALLOWANCE: ",X,!?5,"OBLIGATED BALANCE: "

 S X=$J(ACHSACT0,1,2)

 D FMT

 W !?26,"---------------",!?3,"UNOBLIGATED BALANCE: ",?24

 S X=$J(ACHSACT1-ACHSACT0,1,2)

 D FMT

 H 5

 W @IOF

 Q

 ;

SB1 ;

 S X=$P(^ACHSEOBR("ACHSBBAL",ACHSFY),U,K)

 S ACHSRTOT(ACHSFY,"BBAL")=ACHSRTOT(ACHSFY,"BBAL")+X

 D FMT

 F ACHSX="+","-","TOT" S X=$P(^ACHSEOBR("ACHSSUM",ACHSFY,ACHSX),U,K) S ACHSRTOT(ACHSFY,ACHSX)=ACHSRTOT(ACHSFY,ACHSX)+X D FMT

 S X=$P(^ACHSEOBR("ACHSBBAL",ACHSFY),U,K)+$P(^ACHSEOBR("ACHSSUM",ACHSFY,"TOT"),U,K)

 S ACHSRTOT(ACHSFY,"RTOT")=ACHSRTOT(ACHSFY,"RTOT")+X

 D FMT

 Q

 ;

SB2 ;

 S ACHS=$P(^ACHSEOBR("ACHSTOT",ACHSFY,ACHSTYPE),U),ACHS1=$P(^ACHSEOBR("ACHSTOT",ACHSFY,ACHSTYPE),U,2)

 I ACHSTYPE="INTERIM PAYMENTS" S X=ACHS D COMMA^%DTC S ACHS=X Q

 S $P(ACHSTOT(ACHSFY,"TOTALS"),U,2)=$P(ACHSTOT(ACHSFY,"TOTALS"),U,2)+ACHS1,$P(ACHSTOT(ACHSFY,"TOTALS"),U)=$P(ACHSTOT(ACHSFY,"TOTALS"),U)+ACHS

 S X=ACHS

 D COMMA^%DTC

 S ACHS=X

 Q

 ;

HDR ;

 U ACHSIO

 W @IOF

 S ACHSPG=ACHSPG+1

 W @IOF,?80-$L(ACHSLOC)/2,ACHSLOC,!,ACHSTIME,?25,"CHS EOBR RECONCILIATION",?72,"PAGE ",ACHSPG,!?33,ACHSFY,!!

 Q

 ;

HDR1 ;

 W !!?4,"REGISTER",?20,"BEGINNING",?32,"INCREASED",?45,"DECREASED",?58,"NET",?71,"ENDING",!?21,"BALANCE",?34,"AMOUNT",?46,"AMOUNT",?59,"CHANGE",?71,"BALANCE",!,"----------------"

 Q

 ;

HDR2 ;

 W ?18,"------------",?32,"----------",?44,"----------",?56,"----------",?68,"-----------",!

 Q

 ;

HDR3 ;EP.

 W !!!?7,"Type Document",?40,"No. Documents",?61,"Obligations",!?5,"----------------",?40,"--------------",?60,"--------------"

 Q

 ;

FMT ; 

 I '+X,'+$P(X,".",2) S X=$J("",X3) W X S X=0 Q

 D COMMA^%DTC

 W X

 S X=0

 Q

 ;

SET ;EP

 S ACHSFY=$O(ACHSSUM(ACHSFY))

 Q:ACHSFY=""

 S:$D(ACHSBBAL(ACHSFY)) ^ACHSEOBR("ACHSBBAL",ACHSFY)=ACHSBBAL(ACHSFY)

 S:$D(ACHSSUM(ACHSFY)) ^ACHSEOBR("ACHSSUM",ACHSFY)=ACHSSUM(ACHSFY)

 S:$D(ACHSSUM(ACHSFY,"+")) ^ACHSEOBR("ACHSSUM",ACHSFY,"+")=ACHSSUM(ACHSFY,"+")

 S:$D(ACHSSUM(ACHSFY,"-")) ^ACHSEOBR("ACHSSUM",ACHSFY,"-")=ACHSSUM(ACHSFY,"-")

 F I="PAYMENTS","ADJUSTMENTS","INTERIM PAYMENTS" S:$D(ACHSTOT(ACHSFY,I)) ^ACHSEOBR("ACHSTOT",ACHSFY,I)=ACHSTOT(ACHSFY,I)

 G SET

 ;

ACHSEOBI  ; IHS/ITSC/PMF - EOBR RECONCILIATION ;  [ 10/16/2001   8:16 AM ]

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

 +2       ;

 +3        SET (ACHSFY,ACHSCNT,ACHSSUM,ACHSBBAL,ACHSEBAL,ACHSTOT,ACHSPG)=0

           SET ACHSIO=IO

           SET ACHSLOC=$$LOC^ACHS

 +4        DO NOW^ACHS

BEGIN     ; Main process loop.

 +1        SET ACHSFY=$ORDER(^ACHSEOBR("ACHSSUM",ACHSFY))

 +2        IF ACHSFY=""

               GOTO END

 +3        DO SUMMARY

           DO REPORT

 +4        GOTO BEGIN

 +5       ;

END       ; Kill vars, close device, quit.

 +1        KILL ACHS1,ACHSACT0,ACHSFY,ACHSSUM,ACHSBBAL,ACHSEBAL,ACHSREG,ACHSTOT,ACHSADJ,ACHSAMT,ACHSDCR

 +2        DO ^%ZISC

 +3        QUIT 

 +4       ;

SUMMARY   ;

 +1        DO HDR

           DO HDR3

 +2        WRITE !!

 +3        SET ACHSTOT(ACHSFY,"TOTALS")=0

 +4        FOR ACHSTYPE="PAYMENTS","ADJUSTMENTS","INTERIM PAYMENTS"

               Begin DoDot:1

 +5                IF $DATA(^ACHSEOBR("ACHSTOT",ACHSFY,ACHSTYPE))

                       DO SB2

                       Begin DoDot:2

 +6                        WRITE !?5,ACHSTYPE," DOCUMENTS",?46,$JUSTIFY(ACHS1,5),?57,$JUSTIFY(ACHS,11)

 +7                        IF ACHSTYPE="INTERIM PAYMENTS"

                               WRITE "***"

                               SET ACHSIP=1

 +8                        QUIT 

                       End DoDot:2

 +9                QUIT 

               End DoDot:1

 +10       WRITE !?46,"-----",?60,"--------------"

 +11       SET X=$PIECE(ACHSTOT(ACHSFY,"TOTALS"),U)

 +12       DO COMMA^%DTC

 +13       WRITE !!?5,"TOTALS",?46,$JUSTIFY($PIECE(ACHSTOT(ACHSFY,"TOTALS"),U,2),5),?57,$JUSTIFY(X,11)

 +14       IF $DATA(ACHSIP)

               WRITE !!?5,"*** Interim Payments Not Reflected In Totals"

 +15       KILL ACHSIP

 +16       QUIT 

 +17      ;

REPORT    ;

 +1        DO HDR

           DO HDR1

           DO HDR2

 +2        SET ACHSACTN=$GET(^ACHS(9,DUZ(2),"RN"))

           SET X2=2

           SET X3=12

 +3        SET ACHSRTOT(ACHSFY,"BBAL")=0

           SET ACHSRTOT(ACHSFY,"+")=0

           SET ACHSRTOT(ACHSFY,"-")=0

           SET ACHSRTOT(ACHSFY,"TOT")=0

           SET ACHSRTOT(ACHSFY,"RTOT")=0

 +4        FOR I=1:1:7

               SET $PIECE(^ACHSEOBR("ACHSSUM",ACHSFY,"TOT"),U,I)=$PIECE(^ACHSEOBR("ACHSSUM",ACHSFY,"+"),U,I)+$PIECE(^ACHSEOBR("ACHSSUM",ACHSFY,"-"),U,I)

 +5        FOR K=1:1:7

               WRITE $EXTRACT($PIECE(ACHSACTN,U,K),1,18),?18

               DO SB1

               IF K<7

                   WRITE !

 +6        WRITE !,"----------------"

 +7        DO HDR2

 +8        WRITE "TOTAL",?18

           FOR I="BBAL","+","-","TOT"

 +9        SET X=ACHSRTOT(ACHSFY,I)

 +10       DO FMT

 +11       SET X=ACHSRTOT(ACHSFY,"RTOT")

 +12       DO FMT

 +13       SET ACHSACT0=$PIECE(^ACHS(9,DUZ(2),"FY",ACHSFY,0),U,3)

 +14       SET X2="2$"

           SET X3=18

           SET X=$PIECE(^ACHS(9,DUZ(2),"FY",ACHSFY,0),U,2)

           SET ACHSACT1=X

 +15       DO COMMA^%DTC

 +16       WRITE !!!!!,"YEAR TO DATE ALLOWANCE: ",X,!?5,"OBLIGATED BALANCE: "

 +17       SET X=$JUSTIFY(ACHSACT0,1,2)

 +18       DO FMT

 +19       WRITE !?26,"---------------",!?3,"UNOBLIGATED BALANCE: ",?24

 +20       SET X=$JUSTIFY(ACHSACT1-ACHSACT0,1,2)

 +21       DO FMT

 +22       HANG 5

 +23       WRITE @IOF

 +24       QUIT 

 +25      ;

SB1       ;

 +1        SET X=$PIECE(^ACHSEOBR("ACHSBBAL",ACHSFY),U,K)

 +2        SET ACHSRTOT(ACHSFY,"BBAL")=ACHSRTOT(ACHSFY,"BBAL")+X

 +3        DO FMT

 +4        FOR ACHSX="+","-","TOT"

               SET X=$PIECE(^ACHSEOBR("ACHSSUM",ACHSFY,ACHSX),U,K)

               SET ACHSRTOT(ACHSFY,ACHSX)=ACHSRTOT(ACHSFY,ACHSX)+X

               DO FMT

 +5        SET X=$PIECE(^ACHSEOBR("ACHSBBAL",ACHSFY),U,K)+$PIECE(^ACHSEOBR("ACHSSUM",ACHSFY,"TOT"),U,K)

 +6        SET ACHSRTOT(ACHSFY,"RTOT")=ACHSRTOT(ACHSFY,"RTOT")+X

 +7        DO FMT

 +8        QUIT 

 +9       ;

SB2       ;

 +1        SET ACHS=$PIECE(^ACHSEOBR("ACHSTOT",ACHSFY,ACHSTYPE),U)

           SET ACHS1=$PIECE(^ACHSEOBR("ACHSTOT",ACHSFY,ACHSTYPE),U,2)

 +2        IF ACHSTYPE="INTERIM PAYMENTS"

               SET X=ACHS

               DO COMMA^%DTC

               SET ACHS=X

               QUIT 

 +3        SET $PIECE(ACHSTOT(ACHSFY,"TOTALS"),U,2)=$PIECE(ACHSTOT(ACHSFY,"TOTALS"),U,2)+ACHS1

           SET $PIECE(ACHSTOT(ACHSFY,"TOTALS"),U)=$PIECE(ACHSTOT(ACHSFY,"TOTALS"),U)+ACHS

 +4        SET X=ACHS

 +5        DO COMMA^%DTC

 +6        SET ACHS=X

 +7        QUIT 

 +8       ;

HDR       ;

 +1        USE ACHSIO

 +2        WRITE @IOF

 +3        SET ACHSPG=ACHSPG+1

 +4        WRITE @IOF,?80-$LENGTH(ACHSLOC)/2,ACHSLOC,!,ACHSTIME,?25,"CHS EOBR RECONCILIATION",?72,"PAGE ",ACHSPG,!?33,ACHSFY,!!

 +5        QUIT 

 +6       ;

HDR1      ;

 +1        WRITE !!?4,"REGISTER",?20,"BEGINNING",?32,"INCREASED",?45,"DECREASED",?58,"NET",?71,"ENDING",!?21,"BALANCE",?34,"AMOUNT",?46,"AMOUNT",?59,"CHANGE",?71,"BALANCE",!,"----------------"

 +2        QUIT 

 +3       ;

HDR2      ;

 +1        WRITE ?18,"------------",?32,"----------",?44,"----------",?56,"----------",?68,"-----------",!

 +2        QUIT 

 +3       ;

HDR3      ;EP.

 +1        WRITE !!!?7,"Type Document",?40,"No. Documents",?61,"Obligations",!?5,"----------------",?40,"--------------",?60,"--------------"

 +2        QUIT 

 +3       ;

FMT       ; 

 +1        IF '+X

               IF '+$PIECE(X,".",2)

                   SET X=$JUSTIFY("",X3)

                   WRITE X

                   SET X=0

                   QUIT 

 +2        DO COMMA^%DTC

 +3        WRITE X

 +4        SET X=0

 +5        QUIT 

 +6       ;

SET       ;EP

 +1        SET ACHSFY=$ORDER(ACHSSUM(ACHSFY))

 +2        IF ACHSFY=""

               QUIT 

 +3        IF $DATA(ACHSBBAL(ACHSFY))

               SET ^ACHSEOBR("ACHSBBAL",ACHSFY)=ACHSBBAL(ACHSFY)

 +4        IF $DATA(ACHSSUM(ACHSFY))

               SET ^ACHSEOBR("ACHSSUM",ACHSFY)=ACHSSUM(ACHSFY)

 +5        IF $DATA(ACHSSUM(ACHSFY,"+"))

               SET ^ACHSEOBR("ACHSSUM",ACHSFY,"+")=ACHSSUM(ACHSFY,"+")

 +6        IF $DATA(ACHSSUM(ACHSFY,"-"))

               SET ^ACHSEOBR("ACHSSUM",ACHSFY,"-")=ACHSSUM(ACHSFY,"-")

 +7        FOR I="PAYMENTS","ADJUSTMENTS","INTERIM PAYMENTS"

               IF $DATA(ACHSTOT(ACHSFY,I))

                   SET ^ACHSEOBR("ACHSTOT",ACHSFY,I)=ACHSTOT(ACHSFY,I)

 +8        GOTO SET

 +9       ;