BARCLE.m

BARCLE ; IHS/SD/LSL - Collection Entry for EOBs ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 ;;

 ; IHS/ASDS/LSL -06/15/01 - V1.5 Patch 1 - NOIS HQW-0201-100027

 ;     FM 22 issue.  Modified to include E in DIC(0)

 ;

 ; *********************************************************************

 ;

EOB ;EP for EOB entries

 K DR

 S DIE=BARDIC_BARCLDA_",1,"

 S DA=BARITDA

 S DA(1)=BARCLDA

 S DR="11;"

 S:+BARSPAR(2,"I") DR=DR_"12;"

 S DR=DR_"S DIE(""NO^"")=""BACK"";101;7;8;"

 S:+BARSPAR(3,"I") DR=DR_"10;"

 S DR=DR_"201//^S X=$G(BARBL(3));301;16//^S X=BARCLID(3)"

 W:(BARCLID(2,"I")="E") !,"Up Arrow at check number to exit loop & KILL the New Entry"

 S DIDEL=90050

 D ^DIE

 K DIDEL,DIE("NO^")

 I $D(Y) S BARQUIT=1 Q  ; user up arrowed out

 ; -------------------------------

 ;

EOBSUB ;EP

 ; Enter data for sub EOB locations and amounts

 ;

LOOP ;EP

 ; loop subs for entries and amounts

 K DIC,DR,DA,DIE

 S DA(2)=BARCLDA

 S DA(1)=BARITDA

 S DIC="^BARCOL(DUZ(2),"_BARCLDA_",1,"_BARITDA_",6,"

 S DIC(0)="EAQMLZ"

 S DIC("P")=$P(^DD(90051.1101,601,0),U,2)

 F  S DIC(0)="AEQMLZ",DIC("W")="W ?35,$J($P(^(0),U,2),8,2)" D ^DIC Q:+Y'>0  S DIE=DIC,DA=+Y,DR="2;S BARAMT=X" S DIDEL=90050 D ^DIE K DIDEL D:'BARAMT KILLSUB K DIC("P")

 D BARCLIT^BARCLU

 I +BARCLIT(202.5)'=0 W !,"BALANCE OFF BY ",BARCLIT(202.5) G LOOP

 ;

ENDEOB ;

 Q

 ; *********************************************************************

 ;

KILLSUB ; EP

 ; kill eob sub when the entry is 0

 D ^XBNEW("KSUB^BARCLE:DA*;DIE")

 Q

 ; *********************************************************************

 ;

KSUB ;EP

 ; kill eob sub

 S DIK=DIE

 D ^DIK

 Q

 ; *********************************************************************

 ;

INSERT ;

CHECK ;EP

 ; for checks

 S DR="11;"

 S:+BARSPAR(2,"I") DR=DR_"12;"

 S DR=DR_"101;Q;6///^S X="""" D ^BARBLLK S:$D(BARBL)>1 X=BARBL(.01);Q;6;5;7;8;Q;"

 S:+BARSPAR(3,"I") DR=DR_"10;"

 S DR=DR_"201//^S X=$G(BARBL(3));301;16//^S X=BARCLID(3)"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 Q

 ; *********************************************************************

 ;

CC ;EP credit card

BARCLE    ; IHS/SD/LSL - Collection Entry for EOBs ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 +2       ;;

 +3       ; IHS/ASDS/LSL -06/15/01 - V1.5 Patch 1 - NOIS HQW-0201-100027

 +4       ;     FM 22 issue.  Modified to include E in DIC(0)

 +5       ;

 +6       ; *********************************************************************

 +7       ;

EOB       ;EP for EOB entries

 +1        KILL DR

 +2        SET DIE=BARDIC_BARCLDA_",1,"

 +3        SET DA=BARITDA

 +4        SET DA(1)=BARCLDA

 +5        SET DR="11;"

 +6        IF +BARSPAR(2,"I")

               SET DR=DR_"12;"

 +7        SET DR=DR_"S DIE(""NO^"")=""BACK"";101;7;8;"

 +8        IF +BARSPAR(3,"I")

               SET DR=DR_"10;"

 +9        SET DR=DR_"201//^S X=$G(BARBL(3));301;16//^S X=BARCLID(3)"

 +10       IF (BARCLID(2,"I")="E")

               WRITE !,"Up Arrow at check number to exit loop & KILL the New Entry"

 +11       SET DIDEL=90050

 +12       DO ^DIE

 +13       KILL DIDEL,DIE("NO^")

 +14      ; user up arrowed out

           IF $DATA(Y)

               SET BARQUIT=1

               QUIT 

 +15      ; -------------------------------

 +16      ;

EOBSUB    ;EP

 +1       ; Enter data for sub EOB locations and amounts

 +2       ;

LOOP      ;EP

 +1       ; loop subs for entries and amounts

 +2        KILL DIC,DR,DA,DIE

 +3        SET DA(2)=BARCLDA

 +4        SET DA(1)=BARITDA

 +5        SET DIC="^BARCOL(DUZ(2),"_BARCLDA_",1,"_BARITDA_",6,"

 +6        SET DIC(0)="EAQMLZ"

 +7        SET DIC("P")=$PIECE(^DD(90051.1101,601,0),U,2)

 +8        FOR 

               SET DIC(0)="AEQMLZ"

               SET DIC("W")="W ?35,$J($P(^(0),U,2),8,2)"

               DO ^DIC

               IF +Y'>0

                   QUIT 

               SET DIE=DIC

               SET DA=+Y

               SET DR="2;S BARAMT=X"

               SET DIDEL=90050

               DO ^DIE

               KILL DIDEL

               IF 'BARAMT

                   DO KILLSUB

               KILL DIC("P")

 +9        DO BARCLIT^BARCLU

 +10       IF +BARCLIT(202.5)'=0

               WRITE !,"BALANCE OFF BY ",BARCLIT(202.5)

               GOTO LOOP

 +11      ;

ENDEOB    ;

 +1        QUIT 

 +2       ; *********************************************************************

 +3       ;

KILLSUB   ; EP

 +1       ; kill eob sub when the entry is 0

 +2        DO ^XBNEW("KSUB^BARCLE:DA*;DIE")

 +3        QUIT 

 +4       ; *********************************************************************

 +5       ;

KSUB      ;EP

 +1       ; kill eob sub

 +2        SET DIK=DIE

 +3        DO ^DIK

 +4        QUIT 

 +5       ; *********************************************************************

 +6       ;

INSERT    ;

CHECK     ;EP

 +1       ; for checks

 +2        SET DR="11;"

 +3        IF +BARSPAR(2,"I")

               SET DR=DR_"12;"

 +4        SET DR=DR_"101;Q;6///^S X="""" D ^BARBLLK S:$D(BARBL)>1 X=BARBL(.01);Q;6;5;7;8;Q;"

 +5        IF +BARSPAR(3,"I")

               SET DR=DR_"10;"

 +6        SET DR=DR_"201//^S X=$G(BARBL(3));301;16//^S X=BARCLID(3)"

 +7        SET DIDEL=90050

 +8        DO ^DIE

 +9        KILL DIDEL

 +10       QUIT 

 +11      ; *********************************************************************

 +12      ;

CC        ;EP credit card