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 ;
