ACHSPAI ; IHS/ITSC/PMF - DOCUMENT PAYMENT - INTEREST & PENALTY ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
EDIT ;EP - From Option. Edit Interest and Penalty Data.
Q
;
D SEL^ACHSPAM ;SELECT DOCUMENT AND DISPLAY DATA
I $D(DUOUT)!($D(DTOUT))!'$D(ACHSDIEN) D END Q
;
D PROMPT ;input to Interest fields from EOBR.
I $D(DUOUT)!$D(DTOUT) D END Q
;
D PROCESS ;
;
D RTRN^ACHS
;
D END
Q
;
END ; Kill vars, quit.
K DR,D0,D1
Q
;
PROMPT ; Prompt user for input to Interest fields from EOBR.
N DIC,DIE
S:'$D(D0) D0=DUZ(2)
S:'$D(D1) D1=ACHSDIEN
I '$G(ACHSTIEN) S ACHSTIEN=$$SELTRANS^ACHSUD(ACHSDIEN)
Q:$D(DUOUT)!$D(DTOUT)
S DA(2)=DUZ(2),DA(1)=ACHSDIEN,DA=ACHSTIEN
F ACHS=22:1:29 S ACHS(ACHS)=$$DIR^XBDIR("9002080.02,"_ACHS_"""","",$$VAL^XBDIQ1(9002080.02,.DA,ACHS)) Q:$D(DUOUT)!$D(DTOUT) S:X="@" ACHS(ACHS)="@"
Q
;
PROCESS ;TRY TO ENTER THE DATA
I '$$DIET^ACHS("22////"_$P(ACHS(22),U)_";23////"_ACHS(23)_";24///"_ACHS(24)_";25///"_ACHS(25)_";26///"_ACHS(26)_";27///"_ACHS(27)_";28///"_ACHS(28)) D
. W:'$D(ZTQUEUED) *7,"Interest data failed DIE at PROCESS^ACHSPAI"
. I $D(ACHSISAO) S ACHSERRE=37,ACHSEDAT="" D ^ACHSEOBG ;INTEREST DATA FAILED DIE;W
;
Q
;
DISP ;EP - Display Interest info from selected doc.
D ^ACHSUD
Q:$D(DUOUT)!$D(DTOUT)!'$D(ACHSDIEN)
S ACHSTIEN=$$SELTRANS^ACHSUD(ACHSDIEN)
Q:$D(DUOUT)!$D(DTOUT)
S DA(2)=DUZ(2),DA(1)=ACHSDIEN,DA=ACHSTIEN
F ACHS=22:1:28 W !?5,$P(^DD(9002080.02,ACHS,0),U),$E($$REPEAT^XLFSTR(".",35),1,35-$L($P(^(0),U)))," ",$$VAL^XBDIQ1(9002080.02,.DA,ACHS)
D RTRN^ACHS
Q
;
INT ;EP - Calculate Interest amount.
N ACHSP,ACHSI,ACHSD
W !,"You need to enter Pay amount, Interest rate, and # days late."
S ACHSP=$$DIR^XBDIR("N^::2"," Enter Payment Amount")
Q:$D(DUOUT)!$D(DTOUT)
S ACHSI=$$DIR^XBDIR("N^::2","Enter Interest Rate, e.g., 5.87")
Q:$D(DUOUT)!$D(DTOUT)
S ACHSD=$$DIR^XBDIR("N^::2"," Enter Number of Days Late")
Q:$D(DUOUT)!$D(DTOUT)
W !,"The calculated Interest Amount is $",$FN(ACHSP*ACHSI*.01*ACHSD/360,",",2)
W !," ( amt * rate * days / 360 )"
W !," ( ",ACHSP," * ( ",ACHSI," * .01 ) * ",ACHSD," / 360 )"
D RTRN^ACHS
Q
;
AUTO ;EP - For auto EOBR processing of Interest data.
F ACHS=22:1:28 S ACHS(ACHS)=$G(ACHSEOBR("I",ACHS-14))
;
; Interest CAN
S %=$O(^ACHS(2,"B",ACHS(22),0))
I % S ACHS(22)=%
E I ACHS(22)?7UN S ACHSERRE=38,ACHSEDAT=ACHS(22) D ^ACHSEOBG
I ACHS(22)?1." " S ACHS(22)=""
;
; Interest OCC
S %=$O(^ACHS(3,DUZ(2),1,"B",ACHS(23),0))
I % S ACHS(23)=%
E I ACHS(23)?4UN S ACHSERRE=39,ACHSEDAT=ACHS(23) D ^ACHSEOBG
I ACHS(23)?1." " S ACHS(23)=""
;
; Interest Rate
I ACHS(24) S %=ACHS(24),%=+$E(%,1,2)_"."_$E(%,3,5),ACHS(24)=%
E S ACHS(24)=""
;
; Interest Days Eligible
I ACHS(25) S ACHS(25)=+ACHS(25)
E S ACHS(25)=""
;
; Interest Paid
I ACHS(26) S %=ACHS(26),%=+$E(%,1,7)_"."_$E(%,8,9),ACHS(26)=%
E S ACHS(26)=""
;
; Interest Additional Penalty Paid
I ACHS(27) S %=ACHS(27),%=+$E(%,1,4)_"."_$E(%,5,6),ACHS(27)=%
E S ACHS(27)=""
;
; Interest Total Paid This Transaction
I ACHS(28) S %=ACHS(28),%=+$E(%,1,8)_"."_$E(%,9,10),ACHS(28)=%
E S ACHS(28)=""
;
D PROCESS
Q
;
ACHSPAI ; IHS/ITSC/PMF - DOCUMENT PAYMENT - INTEREST & PENALTY ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
EDIT ;EP - From Option. Edit Interest and Penalty Data.
+1 QUIT
+2 ;
+3 ;SELECT DOCUMENT AND DISPLAY DATA
DO SEL^ACHSPAM
+4 IF $DATA(DUOUT)!($DATA(DTOUT))!'$DATA(ACHSDIEN)
DO END
QUIT
+5 ;
+6 ;input to Interest fields from EOBR.
DO PROMPT
+7 IF $DATA(DUOUT)!$DATA(DTOUT)
DO END
QUIT
+8 ;
+9 ;
DO PROCESS
+10 ;
+11 DO RTRN^ACHS
+12 ;
+13 DO END
+14 QUIT
+15 ;
END ; Kill vars, quit.
+1 KILL DR,D0,D1
+2 QUIT
+3 ;
PROMPT ; Prompt user for input to Interest fields from EOBR.
+1 NEW DIC,DIE
+2 IF '$DATA(D0)
SET D0=DUZ(2)
+3 IF '$DATA(D1)
SET D1=ACHSDIEN
+4 IF '$GET(ACHSTIEN)
SET ACHSTIEN=$$SELTRANS^ACHSUD(ACHSDIEN)
+5 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+6 SET DA(2)=DUZ(2)
SET DA(1)=ACHSDIEN
SET DA=ACHSTIEN
+7 FOR ACHS=22:1:29
SET ACHS(ACHS)=$$DIR^XBDIR("9002080.02,"_ACHS_"""","",$$VAL^XBDIQ1(9002080.02,.DA,ACHS))
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
IF X="@"
SET ACHS(ACHS)="@"
+8 QUIT
+9 ;
PROCESS ;TRY TO ENTER THE DATA
+1 IF '$$DIET^ACHS("22////"_$PIECE(ACHS(22),U)_";23////"_ACHS(23)_";24///"_ACHS(24)_";25///"_ACHS(25)_";26///"_ACHS(26)_";27///"_ACHS(27)_";28///"_ACHS(28))
Begin DoDot:1
+2 IF '$DATA(ZTQUEUED)
WRITE *7,"Interest data failed DIE at PROCESS^ACHSPAI"
+3 ;INTEREST DATA FAILED DIE;W
IF $DATA(ACHSISAO)
SET ACHSERRE=37
SET ACHSEDAT=""
DO ^ACHSEOBG
End DoDot:1
+4 ;
+5 QUIT
+6 ;
DISP ;EP - Display Interest info from selected doc.
+1 DO ^ACHSUD
+2 IF $DATA(DUOUT)!$DATA(DTOUT)!'$DATA(ACHSDIEN)
QUIT
+3 SET ACHSTIEN=$$SELTRANS^ACHSUD(ACHSDIEN)
+4 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+5 SET DA(2)=DUZ(2)
SET DA(1)=ACHSDIEN
SET DA=ACHSTIEN
+6 FOR ACHS=22:1:28
WRITE !?5,$PIECE(^DD(9002080.02,ACHS,0),U),$EXTRACT($$REPEAT^XLFSTR(".",35),1,35-$LENGTH($PIECE(^(0),U)))," ",$$VAL^XBDIQ1(9002080.02,.DA,ACHS)
+7 DO RTRN^ACHS
+8 QUIT
+9 ;
INT ;EP - Calculate Interest amount.
+1 NEW ACHSP,ACHSI,ACHSD
+2 WRITE !,"You need to enter Pay amount, Interest rate, and # days late."
+3 SET ACHSP=$$DIR^XBDIR("N^::2"," Enter Payment Amount")
+4 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+5 SET ACHSI=$$DIR^XBDIR("N^::2","Enter Interest Rate, e.g., 5.87")
+6 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+7 SET ACHSD=$$DIR^XBDIR("N^::2"," Enter Number of Days Late")
+8 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+9 WRITE !,"The calculated Interest Amount is $",$FNUMBER(ACHSP*ACHSI*.01*ACHSD/360,",",2)
+10 WRITE !," ( amt * rate * days / 360 )"
+11 WRITE !," ( ",ACHSP," * ( ",ACHSI," * .01 ) * ",ACHSD," / 360 )"
+12 DO RTRN^ACHS
+13 QUIT
+14 ;
AUTO ;EP - For auto EOBR processing of Interest data.
+1 FOR ACHS=22:1:28
SET ACHS(ACHS)=$GET(ACHSEOBR("I",ACHS-14))
+2 ;
+3 ; Interest CAN
+4 SET %=$ORDER(^ACHS(2,"B",ACHS(22),0))
+5 IF %
SET ACHS(22)=%
+6 IF '$TEST
IF ACHS(22)?7UN
SET ACHSERRE=38
SET ACHSEDAT=ACHS(22)
DO ^ACHSEOBG
+7 IF ACHS(22)?1." "
SET ACHS(22)=""
+8 ;
+9 ; Interest OCC
+10 SET %=$ORDER(^ACHS(3,DUZ(2),1,"B",ACHS(23),0))
+11 IF %
SET ACHS(23)=%
+12 IF '$TEST
IF ACHS(23)?4UN
SET ACHSERRE=39
SET ACHSEDAT=ACHS(23)
DO ^ACHSEOBG
+13 IF ACHS(23)?1." "
SET ACHS(23)=""
+14 ;
+15 ; Interest Rate
+16 IF ACHS(24)
SET %=ACHS(24)
SET %=+$EXTRACT(%,1,2)_"."_$EXTRACT(%,3,5)
SET ACHS(24)=%
+17 IF '$TEST
SET ACHS(24)=""
+18 ;
+19 ; Interest Days Eligible
+20 IF ACHS(25)
SET ACHS(25)=+ACHS(25)
+21 IF '$TEST
SET ACHS(25)=""
+22 ;
+23 ; Interest Paid
+24 IF ACHS(26)
SET %=ACHS(26)
SET %=+$EXTRACT(%,1,7)_"."_$EXTRACT(%,8,9)
SET ACHS(26)=%
+25 IF '$TEST
SET ACHS(26)=""
+26 ;
+27 ; Interest Additional Penalty Paid
+28 IF ACHS(27)
SET %=ACHS(27)
SET %=+$EXTRACT(%,1,4)_"."_$EXTRACT(%,5,6)
SET ACHS(27)=%
+29 IF '$TEST
SET ACHS(27)=""
+30 ;
+31 ; Interest Total Paid This Transaction
+32 IF ACHS(28)
SET %=ACHS(28)
SET %=+$EXTRACT(%,1,8)_"."_$EXTRACT(%,9,10)
SET ACHS(28)=%
+33 IF '$TEST
SET ACHS(28)=""
+34 ;
+35 DO PROCESS
+36 QUIT
+37 ;
