Routine: BARCLU3

BARCLU3 ; IHS/SD/LSL - EDIT/CANCEL WITH AUDIT ; 07/22/2010

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,19**;OCT 26, 2005

 ; IHS/SD/SDR - v1.8 p4 - DD item 4.1.5.1

 ;   Removed change that was done previously in patch 4 because the user

 ;   can't edit the TDN on the item itself, only on the batch.

 ; IHS/SD/TMM 06/18/2010 1.8*19

 ;  NEWITEM^BARCLU moved to ^BARCLU4 due to SAC size limitation

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

 ; select item

 W $$EN^BARVDF("IOF")

 W !,"Edit / Cancel and Item with Auditing",!

 K DIC

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

ITEM ;

 S DIC("W")="D DICW^BARCLU2"

 S DIC("A")="ITEM: "

 S DIC=BARDIC_BARCLDA_",1,"

 S DA(1)=BARCLDA

 S DIC(0)="SMA"

 S DIC("S")="I ""E""[$P(^(0),U,17)"

 S DIC(0)="AEQMZ"

 D ^DIC

 Q:Y'>0

 S BARITDA=+Y

 D BARCLIT^BARCLU

 S BARX=BARCLIT(2,"I")

 D DISPLAY

 K DIR

 S DIR(0)="S^E:Edit w Audit;C:Cancel;Q:Quit"

 D ^DIR

 G:Y="Q" ITEM

 I Y="C" D CANCEL I 1

 E  D EDIT

 G ITEM

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

CANCEL ; EP

 ; cancel a batch item

 K DA,DR,DIE

 S DR="501;17////C;102///^S X=BARCLIT(101);402////^S X=DUZ;403///NOW"

 S DIE=$$DIC^XBDIQ1(90051.1101)

 S DA=BARITDA

 S DA(1)=+BARCL("ID")

 S DIDEL=90050

 D ^DIE

 K DIDEL

 D BARCLIT^BARCLU

 D DISPLAY

 K DIR

 S DIR(0)="S^R:RE-EDIT;C:CONTINUE TO CANCEL"

 D ^DIR

 G:Y="R" CANCEL

 I '$D(BARCLIT(501)) D  G CANCEL

 . W !!,*7,"Error Comment Required",!

 . D EOP^BARUTL(0)

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

EDIT  ;EP

  ; rollup and then edit the new item

 D ERRORCOM

 K DA,DIE,DIC,DR

 S DIE=$$DIC^XBDIQ1(90051.1101)

 S (DA,BAROLD)=BARITDA

 S DA(1)=BARCLDA

 S DR="102///^S X=BARCLIT(101);402////^S X=DUZ;403///NOW"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 D ROLL

 D ITEMEDIT

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

ERRORCOM ; EP

 ; LOOP FOR ERROR COMMENT

 S DIE=$$DIC^XBDIQ1(90051.1101)

 S (DA,BAROLD)=BARITDA

 S DA(1)=BARCLDA

 S DR="501"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 D BARCLIT^BARCLU

 D DISPLAY

 I '$D(BARCLIT(501)) D  G ERRORCOM

 . W !!,*7,"Error Comment Required",!

 . D EOP^BARUTL(0)

 K DIR

 S DIR(0)="Y"

 S DIR("B")="YES"

 S DIR("A")="Is the comment correct ?"

 D ^DIR

 I Y'=1 G ERRORCOM

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

ROLL ;

 S BAROLD=BARITDA

 D BARCLIT^BARCLU ;pull up old item

 ;D NEWITEM^BARCLU  ;M819*DEL*TMM*20100722--moved to ^BARCLU4

 D NEWITEM^BARCLU4

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

UPDATE ;

 S (BARNEW,BARITDA)=+Y

 K DIE,DR,DA,DIC

 S DA=BARITDA

 S DA(1)=BARCLDA

 S DIE=$$DIC^XBDIQ1(90051.1101)

 S DR="405///^S X=BAROLD;"

 F BARI=2,4,5,6,7,8,9,10,16,17 S:(BARCLIT(BARI,"I"))]"" DR=DR_BARI_"////"_BARCLIT(BARI,"I")_";"

 F BARI=11,12,13,14,101,201,203 S:(BARCLIT(BARI)]"") DR=DR_BARI_"///"_BARCLIT(BARI)_";"

 ;BAR*1.8*4 FIX SCHEDULE NUMBER SHOULD BE AVAILABLE TO EDIT AND DISPLAY

 ;F BARI=11,12,13,14,101,201,203,20 S:(BARCLIT(BARI)]"") DR=DR_BARI_"///"_BARCLIT(BARI)_";"

 ;END

 S DIDEL=90050

 D ^DIE

 K DIDEL

 K DR,DA,DIE,DIC

 S DA=BAROLD

 S DA(1)=BARCLDA

 S DIE=$$DIC^XBDIQ1(90051.1101)

 S DR="17////R;404///^S X=BARNEW"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 K DR,DA,DIE,DIC

 S DA=BARCLDA

 S DIE=$$DIC^XBDIQ1(90051.01)

 S DR="7///^S X=BARCL(7)"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 S BARITDA=BARNEW

 D BARCLIT^BARCLU

 K DR,DA,DIE,DIC

EROLL ;

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

ITEMEDIT ;EP edit collection item

 S BARX=BARCLIT(2,"I")

 K DIE,BARBL

 S DA=BARITDA

 S DA(1)=BARCLDA

 S DIE=$$DIC^XBDIQ1(90051.1101)

 D:BARX=51 EOB

 D:BARX=52 CASH

 D:BARX=53 CC

 D:BARX=55 REFUND

 D:BARX=81 CHECK

 D:BARX=99 GL

 D DISPLAY

 K DIR

 S DIR(0)="Y"

 S DIR("A")="ABOVE IS CORRECT ?"

 S DIR("B")="YES"

 D ^DIR

 I Y'>0 G ITEMEDIT

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

CHECK ; EP

 ; for checks

 D CHECK^BARCLU0

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

CC ; EP

 ; credit card

 S DR=""

 D CC^BARCLU0

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

GL ; EP

 ; general ledger

 S DR="203;"

 D CACC^BARCLU0

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

REFUND ; EP

 ; refund

 S DR="102;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

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

CASH ; EP

 ; cash col

 S DR=""

 D CACC^BARCLU0

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

EOB ;EP

 ;  EOB entry

 ; the following lifted from BARCLU0 and modified

ITEMEOB ;

 K BARQUIT

 S BARAC=BARCLIT(7,"I")

 D SPAYOR^BARCLU0 ;select payor

 S:+Y>0 BARAC=+Y

 I +Y'>0 W !,"SELECTION ERROR ... SELECT PAYOR",! G ITEMEOB

 S DIE=$$DIC^XBDIQ1(90051.1101)

 S DA=BARITDA

 S DA(1)=BARCLDA

 S DR="7////^S X=BARAC;2////51;17////E"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 D BARCLIT^BARCLU

 S BARITTYP=BARCLIT(2)

 W $$EN^BARVDF("IOF")

 W !!,"ENTERING ",BARCL(.01)

 W ?30,"TYPE: ",BARCLID(2)

 W ?50,"BATCH TOTAL: ",$$GET1^DIQ(90051.01,BARCLDA,15),!!

 W "ITEM ",BARITDA,?20,BARCLIT(7)

 S DR="11;S:X="""" BARQUIT=1"

 ;BAR*1.8*4 UFMS ASK TREASURY DEPOSIT NUMBER

 ;I +BARCLID(22,"I") D

 ;.S DR="11;20R;S:X="""" BARQUIT=1"

 ;E  S DR="11;S:X="""" BARQUIT=1"

 ;END BAR*1.8*4

 S DIDEL=90050

 D ^DIE

 K DIDEL

 S DR="103///@;"

 S:BARCLID(12,"I") DR=DR_"12;" ;bnk num

 S DR=DR_"101;" ;amt

 S:BARCLID(13,"I") DR=DR_"10;" ;in/out pat

 S:'BARSPAR(2,"I") DR=DR_"8///^S X=BARSPAR(.01)"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 I BARSPAR(2,"I") D EOBSUB^BARCLU0 I 1 ;multiple 3P facilities

 E  D INSSUB^BARCLU0

 D BARCLIT^BARCLU

 D DISPLAY^BARCLU1

 K BARQUIT

 K DIR

 S DIR(0)="S^E:EDIT;C:CONTINUE"

 S DIR("B")="CONTINUE"

 D ^DIR

 G:Y="E" EOB

EITEMEOB ;

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

PAYOR ; EP

 ; ask PAYOR (A/R Account with DISV(screen)

 S DR=""

 S DIE=DIC

 S:'+BARCLID(12,"I") DR=DR_"12;" ;bnk num

 S DR=DR_"10;16;301;" ;i/o pat,auto print,comment

 S DIDEL=90050

 D ^DIE

 K DIDEL

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

DISPLAY ; EP

 ; display item elements

 D BARCLIT^BARCLU

 D DISPLAY^BARCLU

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

DICW ; EP

 ; help display an item lookup

 D DICW^BARCLU2

BARCLU3   ; IHS/SD/LSL - EDIT/CANCEL WITH AUDIT ; 07/22/2010

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,19**;OCT 26, 2005

 +2       ;

 +3       ; IHS/SD/SDR - v1.8 p4 - DD item 4.1.5.1

 +4       ;   Removed change that was done previously in patch 4 because the user

 +5       ;   can't edit the TDN on the item itself, only on the batch.

 +6       ;

 +7       ; IHS/SD/TMM 06/18/2010 1.8*19

 +8       ;  NEWITEM^BARCLU moved to ^BARCLU4 due to SAC size limitation

 +9       ; ********************************************************************* ;

 +10      ;

 +11      ; select item

 +12       WRITE $$EN^BARVDF("IOF")

 +13       WRITE !,"Edit / Cancel and Item with Auditing",!

 +14       KILL DIC

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

 +16      ;

ITEM      ;

 +1        SET DIC("W")="D DICW^BARCLU2"

 +2        SET DIC("A")="ITEM: "

 +3        SET DIC=BARDIC_BARCLDA_",1,"

 +4        SET DA(1)=BARCLDA

 +5        SET DIC(0)="SMA"

 +6        SET DIC("S")="I ""E""[$P(^(0),U,17)"

 +7        SET DIC(0)="AEQMZ"

 +8        DO ^DIC

 +9        IF Y'>0

               QUIT

 +10       SET BARITDA=+Y

 +11       DO BARCLIT^BARCLU

 +12       SET BARX=BARCLIT(2,"I")

 +13       DO DISPLAY

 +14       KILL DIR

 +15       SET DIR(0)="S^E:Edit w Audit;C:Cancel;Q:Quit"

 +16       DO ^DIR

 +17       IF Y="Q"

               GOTO ITEM

 +18       IF Y="C"

               DO CANCEL

               IF 1

 +19      IF '$TEST

               DO EDIT

 +20       GOTO ITEM

 +21      ; *********************************************************************

 +22      ;

CANCEL    ; EP

 +1       ; cancel a batch item

 +2        KILL DA,DR,DIE

 +3        SET DR="501;17////C;102///^S X=BARCLIT(101);402////^S X=DUZ;403///NOW"

 +4        SET DIE=$$DIC^XBDIQ1(90051.1101)

 +5        SET DA=BARITDA

 +6        SET DA(1)=+BARCL("ID")

 +7        SET DIDEL=90050

 +8        DO ^DIE

 +9        KILL DIDEL

 +10       DO BARCLIT^BARCLU

 +11       DO DISPLAY

 +12       KILL DIR

 +13       SET DIR(0)="S^R:RE-EDIT;C:CONTINUE TO CANCEL"

 +14       DO ^DIR

 +15       IF Y="R"

               GOTO CANCEL

 +16       IF '$DATA(BARCLIT(501))

               Begin DoDot:1

 +17               WRITE !!,*7,"Error Comment Required",!

 +18               DO EOP^BARUTL(0)

               End DoDot:1

               GOTO CANCEL

 +19       QUIT

 +20      ; *********************************************************************

 +21      ;

EDIT      ;EP

 +1       ; rollup and then edit the new item

 +2        DO ERRORCOM

 +3        KILL DA,DIE,DIC,DR

 +4        SET DIE=$$DIC^XBDIQ1(90051.1101)

 +5        SET (DA,BAROLD)=BARITDA

 +6        SET DA(1)=BARCLDA

 +7        SET DR="102///^S X=BARCLIT(101);402////^S X=DUZ;403///NOW"

 +8        SET DIDEL=90050

 +9        DO ^DIE

 +10       KILL DIDEL

 +11       DO ROLL

 +12       DO ITEMEDIT

 +13       QUIT

 +14      ; *********************************************************************

 +15      ;

ERRORCOM  ; EP

 +1       ; LOOP FOR ERROR COMMENT

 +2        SET DIE=$$DIC^XBDIQ1(90051.1101)

 +3        SET (DA,BAROLD)=BARITDA

 +4        SET DA(1)=BARCLDA

 +5        SET DR="501"

 +6        SET DIDEL=90050

 +7        DO ^DIE

 +8        KILL DIDEL

 +9        DO BARCLIT^BARCLU

 +10       DO DISPLAY

 +11       IF '$DATA(BARCLIT(501))

               Begin DoDot:1

 +12               WRITE !!,*7,"Error Comment Required",!

 +13               DO EOP^BARUTL(0)

               End DoDot:1

               GOTO ERRORCOM

 +14       KILL DIR

 +15       SET DIR(0)="Y"

 +16       SET DIR("B")="YES"

 +17       SET DIR("A")="Is the comment correct ?"

 +18       DO ^DIR

 +19       IF Y'=1

               GOTO ERRORCOM

 +20       QUIT

 +21      ; *********************************************************************

 +22      ;

ROLL      ;

 +1        SET BAROLD=BARITDA

 +2       ;pull up old item

           DO BARCLIT^BARCLU

 +3       ;D NEWITEM^BARCLU  ;M819*DEL*TMM*20100722--moved to ^BARCLU4

 +4        DO NEWITEM^BARCLU4

 +5       ; -------------------------------

 +6       ;

UPDATE    ;

 +1        SET (BARNEW,BARITDA)=+Y

 +2        KILL DIE,DR,DA,DIC

 +3        SET DA=BARITDA

 +4        SET DA(1)=BARCLDA

 +5        SET DIE=$$DIC^XBDIQ1(90051.1101)

 +6        SET DR="405///^S X=BAROLD;"

 +7        FOR BARI=2,4,5,6,7,8,9,10,16,17

               IF (BARCLIT(BARI,"I"))]""

                   SET DR=DR_BARI_"////"_BARCLIT(BARI,"I")_";"

 +8        FOR BARI=11,12,13,14,101,201,203

               IF (BARCLIT(BARI)]"")

                   SET DR=DR_BARI_"///"_BARCLIT(BARI)_";"

 +9       ;BAR*1.8*4 FIX SCHEDULE NUMBER SHOULD BE AVAILABLE TO EDIT AND DISPLAY

 +10      ;F BARI=11,12,13,14,101,201,203,20 S:(BARCLIT(BARI)]"") DR=DR_BARI_"///"_BARCLIT(BARI)_";"

 +11      ;END

 +12       SET DIDEL=90050

 +13       DO ^DIE

 +14       KILL DIDEL

 +15       KILL DR,DA,DIE,DIC

 +16       SET DA=BAROLD

 +17       SET DA(1)=BARCLDA

 +18       SET DIE=$$DIC^XBDIQ1(90051.1101)

 +19       SET DR="17////R;404///^S X=BARNEW"

 +20       SET DIDEL=90050

 +21       DO ^DIE

 +22       KILL DIDEL

 +23       KILL DR,DA,DIE,DIC

 +24       SET DA=BARCLDA

 +25       SET DIE=$$DIC^XBDIQ1(90051.01)

 +26       SET DR="7///^S X=BARCL(7)"

 +27       SET DIDEL=90050

 +28       DO ^DIE

 +29       KILL DIDEL

 +30       SET BARITDA=BARNEW

 +31       DO BARCLIT^BARCLU

 +32       KILL DR,DA,DIE,DIC

 +33      ;

EROLL     ;

 +1        QUIT

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

 +3       ;

ITEMEDIT  ;EP edit collection item

 +1        SET BARX=BARCLIT(2,"I")

 +2        KILL DIE,BARBL

 +3        SET DA=BARITDA

 +4        SET DA(1)=BARCLDA

 +5        SET DIE=$$DIC^XBDIQ1(90051.1101)

 +6        IF BARX=51

               DO EOB

 +7        IF BARX=52

               DO CASH

 +8        IF BARX=53

               DO CC

 +9        IF BARX=55

               DO REFUND

 +10       IF BARX=81

               DO CHECK

 +11       IF BARX=99

               DO GL

 +12       DO DISPLAY

 +13       KILL DIR

 +14       SET DIR(0)="Y"

 +15       SET DIR("A")="ABOVE IS CORRECT ?"

 +16       SET DIR("B")="YES"

 +17       DO ^DIR

 +18       IF Y'>0

               GOTO ITEMEDIT

 +19       QUIT

 +20      ; *********************************************************************

 +21      ;

CHECK     ; EP

 +1       ; for checks

 +2        DO CHECK^BARCLU0

 +3        QUIT

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

 +5       ;

CC        ; EP

 +1       ; credit card

 +2        SET DR=""

 +3        DO CC^BARCLU0

 +4        QUIT

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

 +6       ;

GL        ; EP

 +1       ; general ledger

 +2        SET DR="203;"

 +3        DO CACC^BARCLU0

 +4        QUIT

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

 +6       ;

REFUND    ; EP

 +1       ; refund

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

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

               SET DR=DR_"10;"

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

 +5        SET DIDEL=90050

 +6        DO ^DIE

 +7        KILL DIDEL

 +8        QUIT

 +9       ; *********************************************************************

 +10      ;

CASH      ; EP

 +1       ; cash col

 +2        SET DR=""

 +3        DO CACC^BARCLU0

 +4        QUIT

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

 +6       ;

EOB       ;EP

 +1       ;  EOB entry

 +2       ; the following lifted from BARCLU0 and modified

ITEMEOB   ;

 +1        KILL BARQUIT

 +2        SET BARAC=BARCLIT(7,"I")

 +3       ;select payor

           DO SPAYOR^BARCLU0

 +4        IF +Y>0

               SET BARAC=+Y

 +5        IF +Y'>0

               WRITE !,"SELECTION ERROR ... SELECT PAYOR",!

               GOTO ITEMEOB

 +6        SET DIE=$$DIC^XBDIQ1(90051.1101)

 +7        SET DA=BARITDA

 +8        SET DA(1)=BARCLDA

 +9        SET DR="7////^S X=BARAC;2////51;17////E"

 +10       SET DIDEL=90050

 +11       DO ^DIE

 +12       KILL DIDEL

 +13       DO BARCLIT^BARCLU

 +14       SET BARITTYP=BARCLIT(2)

 +15       WRITE $$EN^BARVDF("IOF")

 +16       WRITE !!,"ENTERING ",BARCL(.01)

 +17       WRITE ?30,"TYPE: ",BARCLID(2)

 +18       WRITE ?50,"BATCH TOTAL: ",$$GET1^DIQ(90051.01,BARCLDA,15),!!

 +19       WRITE "ITEM ",BARITDA,?20,BARCLIT(7)

 +20       SET DR="11;S:X="""" BARQUIT=1"

 +21      ;BAR*1.8*4 UFMS ASK TREASURY DEPOSIT NUMBER

 +22      ;I +BARCLID(22,"I") D

 +23      ;.S DR="11;20R;S:X="""" BARQUIT=1"

 +24      ;E  S DR="11;S:X="""" BARQUIT=1"

 +25      ;END BAR*1.8*4

 +26       SET DIDEL=90050

 +27       DO ^DIE

 +28       KILL DIDEL

 +29       SET DR="103///@;"

 +30      ;bnk num

           IF BARCLID(12,"I")

               SET DR=DR_"12;"

 +31      ;amt

           SET DR=DR_"101;"

 +32      ;in/out pat

           IF BARCLID(13,"I")

               SET DR=DR_"10;"

 +33       IF 'BARSPAR(2,"I")

               SET DR=DR_"8///^S X=BARSPAR(.01)"

 +34       SET DIDEL=90050

 +35       DO ^DIE

 +36       KILL DIDEL

 +37      ;multiple 3P facilities

           IF BARSPAR(2,"I")

               DO EOBSUB^BARCLU0

               IF 1

 +38      IF '$TEST

               DO INSSUB^BARCLU0

 +39       DO BARCLIT^BARCLU

 +40       DO DISPLAY^BARCLU1

 +41       KILL BARQUIT

 +42       KILL DIR

 +43       SET DIR(0)="S^E:EDIT;C:CONTINUE"

 +44       SET DIR("B")="CONTINUE"

 +45       DO ^DIR

 +46       IF Y="E"

               GOTO EOB

 +47      ;

EITEMEOB  ;

 +1        QUIT

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

 +3       ;

PAYOR     ; EP

 +1       ; ask PAYOR (A/R Account with DISV(screen)

 +2        SET DR=""

 +3        SET DIE=DIC

 +4       ;bnk num

           IF '+BARCLID(12,"I")

               SET DR=DR_"12;"

 +5       ;i/o pat,auto print,comment

           SET DR=DR_"10;16;301;"

 +6        SET DIDEL=90050

 +7        DO ^DIE

 +8        KILL DIDEL

 +9        QUIT

 +10      ; *********************************************************************

 +11      ;

DISPLAY   ; EP

 +1       ; display item elements

 +2        DO BARCLIT^BARCLU

 +3        DO DISPLAY^BARCLU

 +4        QUIT

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

 +6       ;

DICW      ; EP

 +1       ; help display an item lookup

 +2        DO DICW^BARCLU2

 +3        QUIT

BARCLU3.m