ACHSEOBF ; IHS/ITSC/TPF/PMF - SET VARIABLE FROM DOCUMENT FOR EOBR PRNTING ; JUL 10, 2008
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14,15,23**;JUN 11,2001;Build 43
;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
;3.1*15 11.04.2008 IHS/OIT/FCJ FIXED PRINTING TOTALS
;3.1*23 9.19.2013 IHS/OIT/FCJ ADDED PROC FOR ICD-10
;
F ;EP
;F ARRAY
;F DETAIL RECORD
F I=8:1:16 S ACHSEOBR("F",I)="" ;INIT ARRAY
;
;BELOW GOES THROUGHT THE CPT OR REV INFORMATION SUB FILE OF THE
;DOCUMENT FILE
;
F1 ;
S ACHSCNTR=7 ;INIT F DETAIL FIELD NUMBER
S ACHSCPT=0
S ACHSCSEQ=0 ;INIT SEQUENCE NUMBER FOR CPTS
F S ACHSCPT=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,11,ACHSCPT)) Q:+ACHSCPT=0 D
.Q:$P(^ACHSF(DUZ(2),"D",ACHSDIEN,11,ACHSCPT,0),U,10)'=ACHSTIEN
.S X=$J("",22)
.S $E(X,19)="F" ; SET THE RECORD TYPE FOR ACHSEOBB
.;beginning Y2K fix
.S ACHSCSEQ=ACHSCSEQ+1 ;Y2000
.;Y2000 use CCYYMMDD format in the following record generation
.;
.;GET CPT SUBFILE 0 RECORD
.S ACHSCPT0=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,11,ACHSCPT,0))
.Q:'ACHSCPT0 ;IF NO ZERO RECORD NOTHING TO DO
.;
.;ACHS*3.1*15 11/4/2008 IHS/OIT/FCJ FIX PRINTING VAULES AT THE BOTTEM OF PAGE
.;S ^TMP("ACHSEOB",$J,"F",ACHSCSEQ)=X_$P(ACHSCPT0,U,2)+17000000_$P(^(0),U,3)+17000000 ;Y2000 ;DATE OF SERVICE FROM
.S ^TMP("ACHSEOB",$J,"F",ACHSCSEQ)=X_($P(ACHSCPT0,U,2)+17000000)_($P(ACHSCPT0,U,3)+17000000) ;Y2000 ;DATE OF SERVICE
.;end Y2K fix block
.;
.S A=$P($P(ACHSCPT0,U),";",1),A=$J(" ",5)_A,A=$E(A,$L(A)-4,$L(A)) ;CPT/REVENUE CODE
.S B=$P(ACHSCPT0,U,4),B=$J(" ",2)_B,B=$E(B,$L(B)-2,$L(B)) ;UNITS
.S D=$P(ACHSCPT0,U,5) ;CHARGES BILLED
.S X=""
.F I=1:1:$L(D) I $E(D,I)'="." S X=X_$E(D,I) ;FORMAT OUT DECIMAL
.S D=X,D="000000000"_D,D=$E(D,$L(D)-8,$L(D)) ;FILL OUT D TO 8 PLACES
.S E=$P(ACHSCPT0,U,6) ;CHARGES ALLOWABLE
.S X=""
.F I=1:1:$L(E) I $E(E,I)'="." S X=X_$E(E,I)
.S E=X,E="000000000"_E,E=$E(E,$L(E)-8,$L(E))
.S F=$P(ACHSCPT0,U,7) ;MSG CODE
.S F=$J(" ",4)_F,F=$E(F,$L(F)-3,$L(F))
.S G=$P(ACHSCPT0,U,8) ;TOOTH NUMBER
.S G=$J(" ",2)_G,G=$E(G,$L(G)-2,$L(G))
.S H=$P(ACHSCPT0,U,9) ;TOOTH SURFACE
.S H=$J(" ",5)_H,H=$E(H,$L(H)-5,$L(H))
.;
.;CONSOLIDATE ALL TEMP VARS INTO THE TMP GLOBAL F DETAIL RECORD
.S ^TMP("ACHSEOB",$J,"F",ACHSCSEQ)=$G(^TMP("ACHSEOB",$J,"F",ACHSCSEQ))_A_B_D_E_F_G_H
.;
.S ACHSEOBR("F",8)=$P(ACHSCPT0,U,2) ;DOS FROM
.S ACHSEOBR("F",9)=$P(ACHSCPT0,U,3) ;DOS TO
.S ACHSEOBR("F",10)=$P($P(ACHSCPT0,U,1),";",1) ;CPT/REV CODE
.S ACHSEOBR("F",11)=$P(ACHSCPT0,U,4) ;UNITS
.S ACHSEOBR("F",12)=$P(ACHSCPT0,U,5) ;CHARGES BILLED
.S ACHSEOBR("F",13)=$P(ACHSCPT0,U,6) ;CHARGES ALLOWABLE
.S ACHSEOBR("F",14)=$P(ACHSCPT0,U,7) ;MSG CODE
.S ACHSEOBR("F",15)=$P(ACHSCPT0,U,8) ;TOOTH NUMBER
.S ACHSEOBR("F",16)=$P(ACHSCPT0,U,9) ;TOOTH SURFACE
.;
.;"D",9 IS AN ACCUMULATOR (BILLED BY PROV) ADD UP CHARGES BILLED
.I ACHSEOBR("F",14)'="" S ACHSEOBR("M","B",ACHSEOBR("F",14))=""
.S ACHSEOBR("D",9)=ACHSEOBR("D",9)+ACHSEOBR("F",12)
.I ACHSEOBR("D",9)'["." S ACHSEOBR("D",9)=ACHSEOBR("D",9)_".00"
.;
.;"D",10 IS AN ACCUMULATOR (ALLOWABLE AMT) ADD UP CHARGES ALLOWABLE
.S ACHSEOBR("D",10)=ACHSEOBR("D",10)+ACHSEOBR("F",13)
.I ACHSEOBR("D",10)'["." S ACHSEOBR("D",10)=ACHSEOBR("D",10)_".00"
.;
.;IF EOBR SERVICES BILLED="B" INPATIENT THEN TAKE DIFFERENCE BETWEEN
.;DOS FROM AND DOS TO., IF THIS IS NOT EQUAL TO "B" THE VARIABLE WAS
.;ALREADY SET TO THE WORKLOAD FIELD $P(ACHSTRAN,U,9) IN ACHSEOBA
.I ACHSEOBR("C",10)="B",ACHSCPT=1 S X1=ACHSEOBR("F",9),X2=ACHSEOBR("F",8) D ^%DTC S ACHSEOBR("B",11)=X
;
;
;G ARRAY
;G PROCEDURES ARRAY
G ;
;ACHS*3.1*23 CHANGED FOR LOOP FROM 10 TO 12
F I=8:1:12 S ACHSEOBR("G",I)="" ;INIT ARRAY
;
G1 ;GO THRU PROCEDURE RECORDS AND PULL INFO
S ACHSCNTR=7 ;INTITALIZE MAINFRAM FIELD NUMBER FOR ARRAY
S ACHSPROC=0
F S ACHSPROC=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHSPROC)) Q:+ACHSPROC=0 D
.;GET PROCEDURE 0 RECORD
.S ACHSPRC0=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHSPROC,0))
.Q:$P(ACHSPRC0,U,3)'=ACHSTIEN ;EOBR TRANSACTION # MUST MATCH
.S ACHSCNTR=ACHSCNTR+1
.S ACHSEOBR("G",ACHSCNTR)=$P(ACHSPRC0,U) ;PROCEDURE PTR
.Q:ACHSEOBR("G",ACHSCNTR)=""
.;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
.;S ACHSEOBR("G",ACHSCNTR)=$P($G(^ICD0(ACHSEOBR("G",ACHSCNTR),0)),U) ;PROC CODE
.;S ACHSEOBR("G",ACHSCNTR)=$P($$ICDOP^ICDCODE(ACHSEOBR("G",ACHSCNTR)),U,2) ;PROC CODE ;ACHS*3.1*23
.S ACHSEOBR("G",ACHSCNTR)=$P($$ICDOP^ICDEX(ACHSEOBR("G",ACHSCNTR),,,"I"),U,2) ;PROC CODE ;ACHS*3.1*23
;
;
J ;LOOP THRU TRANSACTION SUBFILE OF DOCUMENT FILE
I $D(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA")) S ACHSPA=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA"),U,6) ;'FINAL PAYMENT AMOUNT'
S (ACHSTR,ACHSOBG,ACHSPA)=0
J1 F S ACHSTR=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTR)) Q:+ACHSTR=0 D
.;GET TRANSACTION 0 RECORD
.S ACHSTRA0=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTR,0))
.Q:ACHSTRA0=""
.;
.;IF TRANSACTION TYPE IS "INITIAL" ADD TO OBLIGATION AMT
.I $P(ACHSTRA0,U,2)="I" S ACHSOBG=ACHSOBG+$P(ACHSTRA0,U,4)
.;
.;IF TRANSACTION TYPE IS "SUPPLEMENTAL" ADD TO OBLIGATION AMT
.I $P(ACHSTRA0,U,2)="S" S ACHSOBG=ACHSOBG+$P(ACHSTRA0,U,4)
.;
.;IF TRANSACTION TYPE IS "CANCELATION" SUBTRACT FROM OBLIGATION AMT
.I $P(ACHSTRA0,U,2)="C" S ACHSOBG=ACHSOBG-$P(ACHSTRA0,U,4)
.;
.;IF TRANSACTION TYPE IS "INTERIM PAYMENT" IGNORE
.;I $P(ACHSTRA0,U,2)="IP" S ACHSPA=ACHSPA+$P(ACHSTRA0,U,4)
.;
.;IF TRANSACTION TYPE IS "ADJUSTMENT" ADD TO UNITS BILLED
.I $P(ACHSTRA0,U,2)="ZA" S ACHSPA=ACHSPA+$P(ACHSTRA0,U,4)
.;ACHS*3.1*23 CHG "E" TO VAR ACHSREJ FOR REC E OR J
.S ACHSEOBR(ACHSREJ,10)=ACHSOBG
.S ACHSEOBR(ACHSREJ,11)=ACHSPA
.S ACHSEOBR(ACHSREJ,11)=ACHSOBG-ACHSPA ;UNITS BILLED=OBLIGATION-ADJUSTMENT
.;
.;EOBR PAY TYPE 'I'=INTERIM 'F'=FINAL
.;IF INTERIM WIPE OUT OBLIGATION AND ADJUSTMENT AMT ??????
.;ACHS*3.1*23 CHG "E" TO VAR ACHSREJ FOR REC E OR J
.I $P(ACHSTRAN,U,15)="I" S (ACHSEOBR(ACHSREJ,10),ACHSEOBR(ACHSREJ,11))="*********" Q ;IF WIPEING OUT WHY BOTHER WITH NEXT TWO LINES?
.I ACHSEOBR(ACHSREJ,10)["." S %=ACHSEOBR(ACHSREJ,10),%=$P(%,".")_$E($P(%,".",2)_"00",1,2),ACHSEOBR(ACHSREJ,10)=%
.E S ACHSEOBR(ACHSREJ,10)=ACHSEOBR(ACHSREJ,10)_"00"
.I ACHSEOBR(ACHSREJ,11)["." S %=ACHSEOBR(ACHSREJ,11),%=$P(%,".")_$E($P(%,".",2)_"00",1,2),ACHSEOBR(ACHSREJ,11)=%
.E S ACHSEOBR(ACHSREJ,11)=ACHSEOBR(ACHSREJ,11)_"00"
Q
;
ACHSEOBF ; IHS/ITSC/TPF/PMF - SET VARIABLE FROM DOCUMENT FOR EOBR PRNTING ; JUL 10, 2008
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14,15,23**;JUN 11,2001;Build 43
+2 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
+3 ;3.1*15 11.04.2008 IHS/OIT/FCJ FIXED PRINTING TOTALS
+4 ;3.1*23 9.19.2013 IHS/OIT/FCJ ADDED PROC FOR ICD-10
+5 ;
F ;EP
+1 ;F ARRAY
+2 ;F DETAIL RECORD
+3 ;INIT ARRAY
FOR I=8:1:16
SET ACHSEOBR("F",I)=""
+4 ;
+5 ;BELOW GOES THROUGHT THE CPT OR REV INFORMATION SUB FILE OF THE
+6 ;DOCUMENT FILE
+7 ;
F1 ;
+1 ;INIT F DETAIL FIELD NUMBER
SET ACHSCNTR=7
+2 SET ACHSCPT=0
+3 ;INIT SEQUENCE NUMBER FOR CPTS
SET ACHSCSEQ=0
+4 FOR
SET ACHSCPT=$ORDER(^ACHSF(DUZ(2),"D",ACHSDIEN,11,ACHSCPT))
IF +ACHSCPT=0
QUIT
Begin DoDot:1
+5 IF $PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,11,ACHSCPT,0),U,10)'=ACHSTIEN
QUIT
+6 SET X=$JUSTIFY("",22)
+7 ; SET THE RECORD TYPE FOR ACHSEOBB
SET $EXTRACT(X,19)="F"
+8 ;beginning Y2K fix
+9 ;Y2000
SET ACHSCSEQ=ACHSCSEQ+1
+10 ;Y2000 use CCYYMMDD format in the following record generation
+11 ;
+12 ;GET CPT SUBFILE 0 RECORD
+13 SET ACHSCPT0=$GET(^ACHSF(DUZ(2),"D",ACHSDIEN,11,ACHSCPT,0))
+14 ;IF NO ZERO RECORD NOTHING TO DO
IF 'ACHSCPT0
QUIT
+15 ;
+16 ;ACHS*3.1*15 11/4/2008 IHS/OIT/FCJ FIX PRINTING VAULES AT THE BOTTEM OF PAGE
+17 ;S ^TMP("ACHSEOB",$J,"F",ACHSCSEQ)=X_$P(ACHSCPT0,U,2)+17000000_$P(^(0),U,3)+17000000 ;Y2000 ;DATE OF SERVICE FROM
+18 ;Y2000 ;DATE OF SERVICE
SET ^TMP("ACHSEOB",$JOB,"F",ACHSCSEQ)=X_($PIECE(ACHSCPT0,U,2)+17000000)_($PIECE(ACHSCPT0,U,3)+17000000)
+19 ;end Y2K fix block
+20 ;
+21 ;CPT/REVENUE CODE
SET A=$PIECE($PIECE(ACHSCPT0,U),";",1)
SET A=$JUSTIFY(" ",5)_A
SET A=$EXTRACT(A,$LENGTH(A)-4,$LENGTH(A))
+22 ;UNITS
SET B=$PIECE(ACHSCPT0,U,4)
SET B=$JUSTIFY(" ",2)_B
SET B=$EXTRACT(B,$LENGTH(B)-2,$LENGTH(B))
+23 ;CHARGES BILLED
SET D=$PIECE(ACHSCPT0,U,5)
+24 SET X=""
+25 ;FORMAT OUT DECIMAL
FOR I=1:1:$LENGTH(D)
IF $EXTRACT(D,I)'="."
SET X=X_$EXTRACT(D,I)
+26 ;FILL OUT D TO 8 PLACES
SET D=X
SET D="000000000"_D
SET D=$EXTRACT(D,$LENGTH(D)-8,$LENGTH(D))
+27 ;CHARGES ALLOWABLE
SET E=$PIECE(ACHSCPT0,U,6)
+28 SET X=""
+29 FOR I=1:1:$LENGTH(E)
IF $EXTRACT(E,I)'="."
SET X=X_$EXTRACT(E,I)
+30 SET E=X
SET E="000000000"_E
SET E=$EXTRACT(E,$LENGTH(E)-8,$LENGTH(E))
+31 ;MSG CODE
SET F=$PIECE(ACHSCPT0,U,7)
+32 SET F=$JUSTIFY(" ",4)_F
SET F=$EXTRACT(F,$LENGTH(F)-3,$LENGTH(F))
+33 ;TOOTH NUMBER
SET G=$PIECE(ACHSCPT0,U,8)
+34 SET G=$JUSTIFY(" ",2)_G
SET G=$EXTRACT(G,$LENGTH(G)-2,$LENGTH(G))
+35 ;TOOTH SURFACE
SET H=$PIECE(ACHSCPT0,U,9)
+36 SET H=$JUSTIFY(" ",5)_H
SET H=$EXTRACT(H,$LENGTH(H)-5,$LENGTH(H))
+37 ;
+38 ;CONSOLIDATE ALL TEMP VARS INTO THE TMP GLOBAL F DETAIL RECORD
+39 SET ^TMP("ACHSEOB",$JOB,"F",ACHSCSEQ)=$GET(^TMP("ACHSEOB",$JOB,"F",ACHSCSEQ))_A_B_D_E_F_G_H
+40 ;
+41 ;DOS FROM
SET ACHSEOBR("F",8)=$PIECE(ACHSCPT0,U,2)
+42 ;DOS TO
SET ACHSEOBR("F",9)=$PIECE(ACHSCPT0,U,3)
+43 ;CPT/REV CODE
SET ACHSEOBR("F",10)=$PIECE($PIECE(ACHSCPT0,U,1),";",1)
+44 ;UNITS
SET ACHSEOBR("F",11)=$PIECE(ACHSCPT0,U,4)
+45 ;CHARGES BILLED
SET ACHSEOBR("F",12)=$PIECE(ACHSCPT0,U,5)
+46 ;CHARGES ALLOWABLE
SET ACHSEOBR("F",13)=$PIECE(ACHSCPT0,U,6)
+47 ;MSG CODE
SET ACHSEOBR("F",14)=$PIECE(ACHSCPT0,U,7)
+48 ;TOOTH NUMBER
SET ACHSEOBR("F",15)=$PIECE(ACHSCPT0,U,8)
+49 ;TOOTH SURFACE
SET ACHSEOBR("F",16)=$PIECE(ACHSCPT0,U,9)
+50 ;
+51 ;"D",9 IS AN ACCUMULATOR (BILLED BY PROV) ADD UP CHARGES BILLED
+52 IF ACHSEOBR("F",14)'=""
SET ACHSEOBR("M","B",ACHSEOBR("F",14))=""
+53 SET ACHSEOBR("D",9)=ACHSEOBR("D",9)+ACHSEOBR("F",12)
+54 IF ACHSEOBR("D",9)'["."
SET ACHSEOBR("D",9)=ACHSEOBR("D",9)_".00"
+55 ;
+56 ;"D",10 IS AN ACCUMULATOR (ALLOWABLE AMT) ADD UP CHARGES ALLOWABLE
+57 SET ACHSEOBR("D",10)=ACHSEOBR("D",10)+ACHSEOBR("F",13)
+58 IF ACHSEOBR("D",10)'["."
SET ACHSEOBR("D",10)=ACHSEOBR("D",10)_".00"
+59 ;
+60 ;IF EOBR SERVICES BILLED="B" INPATIENT THEN TAKE DIFFERENCE BETWEEN
+61 ;DOS FROM AND DOS TO., IF THIS IS NOT EQUAL TO "B" THE VARIABLE WAS
+62 ;ALREADY SET TO THE WORKLOAD FIELD $P(ACHSTRAN,U,9) IN ACHSEOBA
+63 IF ACHSEOBR("C",10)="B"
IF ACHSCPT=1
SET X1=ACHSEOBR("F",9)
SET X2=ACHSEOBR("F",8)
DO ^%DTC
SET ACHSEOBR("B",11)=X
End DoDot:1
+64 ;
+65 ;
+66 ;G ARRAY
+67 ;G PROCEDURES ARRAY
G ;
+1 ;ACHS*3.1*23 CHANGED FOR LOOP FROM 10 TO 12
+2 ;INIT ARRAY
FOR I=8:1:12
SET ACHSEOBR("G",I)=""
+3 ;
G1 ;GO THRU PROCEDURE RECORDS AND PULL INFO
+1 ;INTITALIZE MAINFRAM FIELD NUMBER FOR ARRAY
SET ACHSCNTR=7
+2 SET ACHSPROC=0
+3 FOR
SET ACHSPROC=$ORDER(^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHSPROC))
IF +ACHSPROC=0
QUIT
Begin DoDot:1
+4 ;GET PROCEDURE 0 RECORD
+5 SET ACHSPRC0=$GET(^ACHSF(DUZ(2),"D",ACHSDIEN,10,ACHSPROC,0))
+6 ;EOBR TRANSACTION # MUST MATCH
IF $PIECE(ACHSPRC0,U,3)'=ACHSTIEN
QUIT
+7 SET ACHSCNTR=ACHSCNTR+1
+8 ;PROCEDURE PTR
SET ACHSEOBR("G",ACHSCNTR)=$PIECE(ACHSPRC0,U)
+9 IF ACHSEOBR("G",ACHSCNTR)=""
QUIT
+10 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
+11 ;S ACHSEOBR("G",ACHSCNTR)=$P($G(^ICD0(ACHSEOBR("G",ACHSCNTR),0)),U) ;PROC CODE
+12 ;S ACHSEOBR("G",ACHSCNTR)=$P($$ICDOP^ICDCODE(ACHSEOBR("G",ACHSCNTR)),U,2) ;PROC CODE ;ACHS*3.1*23
+13 ;PROC CODE ;ACHS*3.1*23
SET ACHSEOBR("G",ACHSCNTR)=$PIECE($$ICDOP^ICDEX(ACHSEOBR("G",ACHSCNTR),,,"I"),U,2)
End DoDot:1
+14 ;
+15 ;
J ;LOOP THRU TRANSACTION SUBFILE OF DOCUMENT FILE
+1 ;'FINAL PAYMENT AMOUNT'
IF $DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA"))
SET ACHSPA=$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA"),U,6)
+2 SET (ACHSTR,ACHSOBG,ACHSPA)=0
J1 FOR
SET ACHSTR=$ORDER(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTR))
IF +ACHSTR=0
QUIT
Begin DoDot:1
+1 ;GET TRANSACTION 0 RECORD
+2 SET ACHSTRA0=$GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTR,0))
+3 IF ACHSTRA0=""
QUIT
+4 ;
+5 ;IF TRANSACTION TYPE IS "INITIAL" ADD TO OBLIGATION AMT
+6 IF $PIECE(ACHSTRA0,U,2)="I"
SET ACHSOBG=ACHSOBG+$PIECE(ACHSTRA0,U,4)
+7 ;
+8 ;IF TRANSACTION TYPE IS "SUPPLEMENTAL" ADD TO OBLIGATION AMT
+9 IF $PIECE(ACHSTRA0,U,2)="S"
SET ACHSOBG=ACHSOBG+$PIECE(ACHSTRA0,U,4)
+10 ;
+11 ;IF TRANSACTION TYPE IS "CANCELATION" SUBTRACT FROM OBLIGATION AMT
+12 IF $PIECE(ACHSTRA0,U,2)="C"
SET ACHSOBG=ACHSOBG-$PIECE(ACHSTRA0,U,4)
+13 ;
+14 ;IF TRANSACTION TYPE IS "INTERIM PAYMENT" IGNORE
+15 ;I $P(ACHSTRA0,U,2)="IP" S ACHSPA=ACHSPA+$P(ACHSTRA0,U,4)
+16 ;
+17 ;IF TRANSACTION TYPE IS "ADJUSTMENT" ADD TO UNITS BILLED
+18 IF $PIECE(ACHSTRA0,U,2)="ZA"
SET ACHSPA=ACHSPA+$PIECE(ACHSTRA0,U,4)
+19 ;ACHS*3.1*23 CHG "E" TO VAR ACHSREJ FOR REC E OR J
+20 SET ACHSEOBR(ACHSREJ,10)=ACHSOBG
+21 SET ACHSEOBR(ACHSREJ,11)=ACHSPA
+22 ;UNITS BILLED=OBLIGATION-ADJUSTMENT
SET ACHSEOBR(ACHSREJ,11)=ACHSOBG-ACHSPA
+23 ;
+24 ;EOBR PAY TYPE 'I'=INTERIM 'F'=FINAL
+25 ;IF INTERIM WIPE OUT OBLIGATION AND ADJUSTMENT AMT ??????
+26 ;ACHS*3.1*23 CHG "E" TO VAR ACHSREJ FOR REC E OR J
+27 ;IF WIPEING OUT WHY BOTHER WITH NEXT TWO LINES?
IF $PIECE(ACHSTRAN,U,15)="I"
SET (ACHSEOBR(ACHSREJ,10),ACHSEOBR(ACHSREJ,11))="*********"
QUIT
+28 IF ACHSEOBR(ACHSREJ,10)["."
SET %=ACHSEOBR(ACHSREJ,10)
SET %=$PIECE(%,".")_$EXTRACT($PIECE(%,".",2)_"00",1,2)
SET ACHSEOBR(ACHSREJ,10)=%
+29 IF '$TEST
SET ACHSEOBR(ACHSREJ,10)=ACHSEOBR(ACHSREJ,10)_"00"
+30 IF ACHSEOBR(ACHSREJ,11)["."
SET %=ACHSEOBR(ACHSREJ,11)
SET %=$PIECE(%,".")_$EXTRACT($PIECE(%,".",2)_"00",1,2)
SET ACHSEOBR(ACHSREJ,11)=%
+31 IF '$TEST
SET ACHSEOBR(ACHSREJ,11)=ACHSEOBR(ACHSREJ,11)_"00"
End DoDot:1
+32 QUIT
+33 ;
