Routine: ACHSPAI

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.

 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

END ; Kill vars, quit.

 K DR,D0,D1

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)="@"

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

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

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

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

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      ;

ACHSPAI.m