BARCLU2 ; IHS/SD/LSL - ASK MORE QUESTIONS ON A COLLECTION ITEM ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**4**;OCT 26, 2005
;;
;select item
W $$EN^BARVDF("IOF")
W !,"MORE FUNCTION - add items that were not asked"
K DIC
; -------------------------------
;
ITEM ; EP
D ^XBSFGBL(90051.1101,.DIC)
S DIC=$P(DIC,"DA,")
S DIC("W")="D DICW^BARCLU2"
S DIC("A")="ITEM: "
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
S DR=""
; -------------------------------
;
EDITEM ; EP
; edit collection item
K DIE,BARBL
S DA=BARITDA
S DA(1)=BARCLDA
S DIE=BARDIC_BARCLDA_",1,"
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
G ITEM
; *********************************************************************
;
CHECK ; EP
; for checks
S:'+BARCLID(12,"I") DR=DR_"12;" ;bk num
; -------------------------------
;
CACC ; EP
; for other types
I BARX=52 S:'+BARCLID(15,"I") DR=DR_"6///^S X="""" D ^BARBLLK S:$D(BARBL)>1 X=BARBL(.01);Q;" ;bill CA
I BARX=53 S:'+BARCLID(14,"I") DR=DR_"6///^S X="""" D ^BARBLLK S:$D(BARBL)>1 X=BARBL(.01);Q;" ;bill CC
I BARX=81 S:'+BARCLID(16,"I") DR=DR_"6///^S X="""" D ^BARBLLK S:$D(BARBL)>1 X=BARBL(.01);Q;" ;bill CK
K BARBL
S DIDEL=90050
D ^DIE
K DIDEL
S DR=""
I '$D(BARBL) D
.I BARX=52 S:'+BARCLID(18,"I") DR=DR_"5;" ;pat CA
.I BARX=53 S:'+BARCLID(17,"I") DR=DR_"5;" ;pat CC
.I BARX=81 S:'+BARCLID(19,"I") DR=DR_"5;" ;pat CK
I '$D(BARCLIT(301)) S DR=DR_"301;"
S DIDEL=90050
D ^DIE
K DIDEL
W:DR="" !,"ALL QUESTIONS ALREADY ASKED"
H 5
Q
; *********************************************************************
;
CC ; EP
; credit card
S DR=""
D CACC
Q
; *********************************************************************
;
GL ; EP
; general ledger
S DR=203
D CACC
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
Q
; *********************************************************************
;
EOB ; EP
; EOB entry
D PAYOR
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
;IHS/SD/AML 11/26/07 - Print treasury dep number
FLDS ;;203;GENERAL LEDGER^11;CHECK NUMBER^12;BANK NUMBER^13;CC NUMBER^14;CC VER NUMBER^101;AMOUNT PAID^102;REFUND^7;A/R ACCOUNT^201;PAYOR^8;LOCATION OF SERVICE^10;INPAT/OUTPAT^5;PATIENT^6;BILL^16;AUTO PRINT^20;TREASURY DEPOSIT/IPAC #
;
S BARY=$P($T(FLDS),";;",2)
W $$EN^BARVDF("IOF")
W !,BARCL(.01)
W ?22,"ITEM: ",BARITDA
W " TYPE: ",BARCLIT(2)
W ?54,"BATCH TOTAL: ",$$GET1^DIQ(90051.01,BARCLDA,15)
W !
F BARI=1:1:70 W "="
F BARI=1:1 S BARE=$P(BARY,U,BARI) Q:BARE="" D
. S BARFLD=+BARE
. S BARNM=$P(BARE,";",2)
. I $G(BARCLIT(BARFLD))]"" W !?5,BARNM,?30,BARCLIT(BARFLD)
I $D(BARCLIT(301)) D
. W !,"COMMENTS"
. F BARI=1:1 Q:'$D(BARCLIT(301,BARI)) W !,?3,BARCLIT(301,BARI)
W ! F BARI=1:1:70 W "="
W !
K BARY,BARI,BARNM,BARFLD
Q
; *********************************************************************
;
END ;
DICW ; EP
; help display on Item lookup
D ^XBNEW("DICW1^BARCLU2:Y;BARCL*")
Q
; *********************************************************************
;
DICW1 ;EP
K BARCLIT
N DIC,DA,DR,DIQ
Q:'+Y
S DA=+Y
N Y
S DIQ="BARCLIT("
S DIQ(0)="I"
S DIC=90051.1101
S DA(1)=BARCLDA
S DR="2;2.5;7;11;101"
D EN^XBDIQ1
W ?7,$J($E(BARCLIT(11),1,9),10)
W:$L(BARCLIT(11))>9 "*"
W ?18,$J(BARCLIT(101),8,2),?28,BARCLIT(7),?58,$E(BARCLIT(2.5),1,2)
;
EDICW ;
Q
BARCLU2 ; IHS/SD/LSL - ASK MORE QUESTIONS ON A COLLECTION ITEM ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4**;OCT 26, 2005
+2 ;;
+3 ;select item
+4 WRITE $$EN^BARVDF("IOF")
+5 WRITE !,"MORE FUNCTION - add items that were not asked"
+6 KILL DIC
+7 ; -------------------------------
+8 ;
ITEM ; EP
+1 DO ^XBSFGBL(90051.1101,.DIC)
+2 SET DIC=$PIECE(DIC,"DA,")
+3 SET DIC("W")="D DICW^BARCLU2"
+4 SET DIC("A")="ITEM: "
+5 SET DA(1)=BARCLDA
+6 SET DIC(0)="SMA"
+7 SET DIC("S")="I ""E""[$P(^(0),U,17)"
+8 SET DIC(0)="AEQMZ"
+9 DO ^DIC
+10 IF Y'>0
QUIT
+11 SET BARITDA=+Y
+12 DO BARCLIT^BARCLU
+13 SET BARX=BARCLIT(2,"I")
+14 DO DISPLAY
+15 SET DR=""
+16 ; -------------------------------
+17 ;
EDITEM ; EP
+1 ; edit collection item
+2 KILL DIE,BARBL
+3 SET DA=BARITDA
+4 SET DA(1)=BARCLDA
+5 SET DIE=BARDIC_BARCLDA_",1,"
+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 GOTO ITEM
+14 ; *********************************************************************
+15 ;
CHECK ; EP
+1 ; for checks
+2 ;bk num
IF '+BARCLID(12,"I")
SET DR=DR_"12;"
+3 ; -------------------------------
+4 ;
CACC ; EP
+1 ; for other types
+2 ;bill CA
IF BARX=52
IF '+BARCLID(15,"I")
SET DR=DR_"6///^S X="""" D ^BARBLLK S:$D(BARBL)>1 X=BARBL(.01);Q;"
+3 ;bill CC
IF BARX=53
IF '+BARCLID(14,"I")
SET DR=DR_"6///^S X="""" D ^BARBLLK S:$D(BARBL)>1 X=BARBL(.01);Q;"
+4 ;bill CK
IF BARX=81
IF '+BARCLID(16,"I")
SET DR=DR_"6///^S X="""" D ^BARBLLK S:$D(BARBL)>1 X=BARBL(.01);Q;"
+5 KILL BARBL
+6 SET DIDEL=90050
+7 DO ^DIE
+8 KILL DIDEL
+9 SET DR=""
+10 IF '$DATA(BARBL)
Begin DoDot:1
+11 ;pat CA
IF BARX=52
IF '+BARCLID(18,"I")
SET DR=DR_"5;"
+12 ;pat CC
IF BARX=53
IF '+BARCLID(17,"I")
SET DR=DR_"5;"
+13 ;pat CK
IF BARX=81
IF '+BARCLID(19,"I")
SET DR=DR_"5;"
End DoDot:1
+14 IF '$DATA(BARCLIT(301))
SET DR=DR_"301;"
+15 SET DIDEL=90050
+16 DO ^DIE
+17 KILL DIDEL
+18 IF DR=""
WRITE !,"ALL QUESTIONS ALREADY ASKED"
+19 HANG 5
+20 QUIT
+21 ; *********************************************************************
+22 ;
CC ; EP
+1 ; credit card
+2 SET DR=""
+3 DO CACC
+4 QUIT
+5 ; *********************************************************************
+6 ;
GL ; EP
+1 ; general ledger
+2 SET DR=203
+3 DO CACC
+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
+4 QUIT
+5 ; *********************************************************************
+6 ;
EOB ; EP
+1 ; EOB entry
+2 DO PAYOR
+3 QUIT
+4 ; *********************************************************************
+5 ;
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 ;IHS/SD/AML 11/26/07 - Print treasury dep number
FLDS ;;203;GENERAL LEDGER^11;CHECK NUMBER^12;BANK NUMBER^13;CC NUMBER^14;CC VER NUMBER^101;AMOUNT PAID^102;REFUND^7;A/R ACCOUNT^201;PAYOR^8;LOCATION OF SERVICE^10;INPAT/OUTPAT^5;PATIENT^6;BILL^16;AUTO PRINT^20;TREASURY DEPOSIT/IPAC #
+1 ;
+2 SET BARY=$PIECE($TEXT(FLDS),";;",2)
+3 WRITE $$EN^BARVDF("IOF")
+4 WRITE !,BARCL(.01)
+5 WRITE ?22,"ITEM: ",BARITDA
+6 WRITE " TYPE: ",BARCLIT(2)
+7 WRITE ?54,"BATCH TOTAL: ",$$GET1^DIQ(90051.01,BARCLDA,15)
+8 WRITE !
+9 FOR BARI=1:1:70
WRITE "="
+10 FOR BARI=1:1
SET BARE=$PIECE(BARY,U,BARI)
IF BARE=""
QUIT
Begin DoDot:1
+11 SET BARFLD=+BARE
+12 SET BARNM=$PIECE(BARE,";",2)
+13 IF $GET(BARCLIT(BARFLD))]""
WRITE !?5,BARNM,?30,BARCLIT(BARFLD)
End DoDot:1
+14 IF $DATA(BARCLIT(301))
Begin DoDot:1
+15 WRITE !,"COMMENTS"
+16 FOR BARI=1:1
IF '$DATA(BARCLIT(301,BARI))
QUIT
WRITE !,?3,BARCLIT(301,BARI)
End DoDot:1
+17 WRITE !
FOR BARI=1:1:70
WRITE "="
+18 WRITE !
+19 KILL BARY,BARI,BARNM,BARFLD
+20 QUIT
+21 ; *********************************************************************
+22 ;
END ;
DICW ; EP
+1 ; help display on Item lookup
+2 DO ^XBNEW("DICW1^BARCLU2:Y;BARCL*")
+3 QUIT
+4 ; *********************************************************************
+5 ;
DICW1 ;EP
+1 KILL BARCLIT
+2 NEW DIC,DA,DR,DIQ
+3 IF '+Y
QUIT
+4 SET DA=+Y
+5 NEW Y
+6 SET DIQ="BARCLIT("
+7 SET DIQ(0)="I"
+8 SET DIC=90051.1101
+9 SET DA(1)=BARCLDA
+10 SET DR="2;2.5;7;11;101"
+11 DO EN^XBDIQ1
+12 WRITE ?7,$JUSTIFY($EXTRACT(BARCLIT(11),1,9),10)
+13 IF $LENGTH(BARCLIT(11))>9
WRITE "*"
+14 WRITE ?18,$JUSTIFY(BARCLIT(101),8,2),?28,BARCLIT(7),?58,$EXTRACT(BARCLIT(2.5),1,2)
+15 ;
EDICW ;
+1 QUIT
