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)
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
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 ;
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
CHECK ; EP
; for checks
D CHECK^BARCLU0
Q
; *********************************************************************
;
CC ; EP
; credit card
S DR=""
D CC^BARCLU0
Q
; *********************************************************************
;
GL ; EP
; general ledger
S DR="203;"
D CACC^BARCLU0
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
CASH ; EP
; cash col
S DR=""
D CACC^BARCLU0
Q
; *********************************************************************
;
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 ;
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
DISPLAY ; EP
; display item elements
D BARCLIT^BARCLU
D DISPLAY^BARCLU
Q
; *********************************************************************
;
DICW ; EP
; help display an item lookup
D DICW^BARCLU2
Q
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
