BARDMAN4 ; IHS/SD/LSL - A/R Debt Collection Process (4) ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
; IHS/SD/LSL - 04/16/2004 - V1.8
; Routine created. Moved (modified) from BBMDC2
; All entry points called from BARDMAN2. Updates log from
; each of the four temp globals if send was successful.
;
; ********************************************************************
Q
;
LOGSSELF ; EP
; Log self pay stops
S BARBL=0
F S BARBL=$O(^BARSSELF($J,BARBL)) Q:'+BARBL D
. D INACT ; first, inactivate previous record
. S BARBAL=$E(^BARSSELF($J,BARBL),19,26)
. S BARBAL=$E(BARBAL,1,($L(BARBAL)-2))_"."_$E(BARBAL,($L(BARBAL)-1),$L(BARBAL))
. K DIC,DR,X,Y,DA
. S DIC="^BARDEBT("
. S DIC(0)="ZL"
. S X=DT
. S DIC("DR")=".02///^S X=BARBL"
. S DIC("DR")=DIC("DR")_";.03///^S X=BARBAL"
. S DIC("DR")=DIC("DR")_";.04////^S X=$E(^BARSSELF($J,BARBL),27)"
. S DIC("DR")=DIC("DR")_";.05////^S X=1"
. S DIC("DR")=DIC("DR")_";.06////^S X=""S"""
. S DIC("DR")=DIC("DR")_";.07///^S X=""SELF PAY"""
. S DIC("DR")=DIC("DR")_";.08///^S X=DUZ(2)"
. S DIC("DR")=DIC("DR")_";.09///^S X=BARSSFN"
. S DLAYGO=90050
. K DD,DO
. D FILE^DICN
K DIE,DIC,DR,DA,X,Y
S DIE="^BAR(90052.06,DUZ(2),"
S DA=DUZ(2)
S DR="1105////^S X=BARSTART"
S DR=DR_";1106////^S X=BAREND"
D ^DIE
Q
; ********************************************************************
;
LOGSTOP ; EP
; Log insurer stops
S BARBL=0
F S BARBL=$O(^BARSTOPS($J,BARBL)) Q:'+BARBL D
. D INACT ; first, inactivate previous record
. S BARBAL=$E(^BARSTOPS($J,BARBL),27,34)
. S BARBAL=$E(BARBAL,1,($L(BARBAL)-2))_"."_$E(BARBAL,($L(BARBAL)-1),$L(BARBAL))
. K DIC,DR,X,Y,DA
. S DIC="^BARDEBT("
. S DIC(0)="ZL"
. S X=DT
. S DIC("DR")=".02///^S X=BARBL"
. S DIC("DR")=DIC("DR")_";.03///^S X=BARBAL"
. S DIC("DR")=DIC("DR")_";.04////^S X=$E(^BARSTOPS($J,BARBL),26)"
. S DIC("DR")=DIC("DR")_";.05////^S X=1"
. S DIC("DR")=DIC("DR")_";.06////^S X=""I"""
. S DIC("DR")=DIC("DR")_";.07///^S X=$$GET1^DIQ(90050.01,BARBL,3)"
. S DIC("DR")=DIC("DR")_";.08///^S X=DUZ(2)"
. S DIC("DR")=DIC("DR")_";.09///^S X=BARSIFN"
. S DLAYGO=90050
. K DD,DO
. D FILE^DICN
K DIE,DIC,DR,DA,X,Y
S DIE="^BAR(90052.06,DUZ(2),"
S DA=DUZ(2)
S DR="1105////^S X=BARSTART"
S DR=DR_";1106////^S X=BAREND"
D ^DIE
Q
; ********************************************************************
;
INACT ;
; Inactivate last entry for this bill
S BARLIEN=$O(^BARDEBT("C",BARBL,"A"),-1)
Q:'+BARLIEN
S DIE="^BARDEBT("
S DA=BARLIEN
S DR=".05////^S X=0"
D ^DIE
Q
; ********************************************************************
;
LOGTSELF ; EP
; Log Self Pay Starts
S BARBL=0
F S BARBL=$O(^BARTSELF($J,BARBL)) Q:'+BARBL D
. K DIC,DR,X,Y,DA
. S DIC="^BARDEBT("
. S DIC(0)="ZL"
. S X=DT
. S DIC("DR")=".02///^S X=BARBL"
. S DIC("DR")=DIC("DR")_";.03///^S X=$$GET1^DIQ(90050.01,BARBL,15)"
. S DIC("DR")=DIC("DR")_";.04////^S X=0"
. S DIC("DR")=DIC("DR")_";.05////^S X=1"
. S DIC("DR")=DIC("DR")_";.06////^S X=""S"""
. S DIC("DR")=DIC("DR")_";.07///^S X=""SELF PAY"""
. S DIC("DR")=DIC("DR")_";.08///^S X=DUZ(2)"
. S DIC("DR")=DIC("DR")_";.09///^S X=BARTSFN"
. S DLAYGO=90050
. K DD,DO
. D FILE^DICN
. D MSGTX(BARBL)
; Update current count and last start and stop in parameters
K DIE,DIC,DR,DA,X,Y
S DIE="^BAR(90052.06,DUZ(2),"
S DA=DUZ(2)
S DR="1006///^S X=BARSCUR"
S DR=DR_";1105////^S X=BARSTART"
S DR=DR_";1106////^S X=BAREND"
D ^DIE
Q
; ********************************************************************
;
LOGSTART ; EP
; Log Insurer Starts
S BARBL=0
F S BARBL=$O(^BARSTART($J,BARBL)) Q:'+BARBL D
. K DIC,DR,X,Y,DA
. S DIC="^BARDEBT("
. S DIC(0)="ZL"
. S X=DT
. S DIC("DR")=".02///^S X=BARBL"
. S DIC("DR")=DIC("DR")_";.03///^S X=$$GET1^DIQ(90050.01,BARBL,15)"
. S DIC("DR")=DIC("DR")_";.04////^S X=0"
. S DIC("DR")=DIC("DR")_";.05////^S X=1"
. S DIC("DR")=DIC("DR")_";.06////^S X=""I"""
. S DIC("DR")=DIC("DR")_";.07///^S X=$$GET1^DIQ(90050.01,BARBL,3)"
. S DIC("DR")=DIC("DR")_";.08///^S X=DUZ(2)"
. S DIC("DR")=DIC("DR")_";.09///^S X=BARTIFN"
. S DLAYGO=90050
. K DD,DO
. D FILE^DICN
. D MSGTX(BARBL)
; Update current count and last start and stop in parameters
K DIE,DIC,DR,DA,X,Y
S DIE="^BAR(90052.06,DUZ(2),"
S DA=DUZ(2)
S DR="1003///^S X=BARICUR"
S DR=DR_";1105////^S X=BARSTART"
S DR=DR_";1106////^S X=BAREND"
D ^DIE
Q
; ********************************************************************
MSGTX(BARBL) ;
; Create message transaction on bills sent to Transworld w/ start code
Q:'+BARBL
S BARTR=$$NEW^BARTR
Q:BARTR<1
S BARTRDT=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
S BARMSG="TRANSMITTED TO TRANSWORLD "_BARTRDT
S DA=BARTR
S DIE="^BARTR(DUZ(2),"
S DR="12////^S X=DT"
S DR=DR_";13////^S X=DUZ"
S DR=DR_";7////^S X=1"
S DR=DR_";4////^S X=BARBL"
S DR=DR_";10////^S X=$$GET1^DIQ(200,DUZ,29,""I"")"
S DR=DR_";16////^S X=""P"""
S DR=DR_";1001///^S X=BARMSG"
D ^DIE
Q
BARDMAN4 ; IHS/SD/LSL - A/R Debt Collection Process (4) ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 04/16/2004 - V1.8
+4 ; Routine created. Moved (modified) from BBMDC2
+5 ; All entry points called from BARDMAN2. Updates log from
+6 ; each of the four temp globals if send was successful.
+7 ;
+8 ; ********************************************************************
+9 QUIT
+10 ;
LOGSSELF ; EP
+1 ; Log self pay stops
+2 SET BARBL=0
+3 FOR
SET BARBL=$ORDER(^BARSSELF($JOB,BARBL))
IF '+BARBL
QUIT
Begin DoDot:1
+4 ; first, inactivate previous record
DO INACT
+5 SET BARBAL=$EXTRACT(^BARSSELF($JOB,BARBL),19,26)
+6 SET BARBAL=$EXTRACT(BARBAL,1,($LENGTH(BARBAL)-2))_"."_$EXTRACT(BARBAL,($LENGTH(BARBAL)-1),$LENGTH(BARBAL))
+7 KILL DIC,DR,X,Y,DA
+8 SET DIC="^BARDEBT("
+9 SET DIC(0)="ZL"
+10 SET X=DT
+11 SET DIC("DR")=".02///^S X=BARBL"
+12 SET DIC("DR")=DIC("DR")_";.03///^S X=BARBAL"
+13 SET DIC("DR")=DIC("DR")_";.04////^S X=$E(^BARSSELF($J,BARBL),27)"
+14 SET DIC("DR")=DIC("DR")_";.05////^S X=1"
+15 SET DIC("DR")=DIC("DR")_";.06////^S X=""S"""
+16 SET DIC("DR")=DIC("DR")_";.07///^S X=""SELF PAY"""
+17 SET DIC("DR")=DIC("DR")_";.08///^S X=DUZ(2)"
+18 SET DIC("DR")=DIC("DR")_";.09///^S X=BARSSFN"
+19 SET DLAYGO=90050
+20 KILL DD,DO
+21 DO FILE^DICN
End DoDot:1
+22 KILL DIE,DIC,DR,DA,X,Y
+23 SET DIE="^BAR(90052.06,DUZ(2),"
+24 SET DA=DUZ(2)
+25 SET DR="1105////^S X=BARSTART"
+26 SET DR=DR_";1106////^S X=BAREND"
+27 DO ^DIE
+28 QUIT
+29 ; ********************************************************************
+30 ;
LOGSTOP ; EP
+1 ; Log insurer stops
+2 SET BARBL=0
+3 FOR
SET BARBL=$ORDER(^BARSTOPS($JOB,BARBL))
IF '+BARBL
QUIT
Begin DoDot:1
+4 ; first, inactivate previous record
DO INACT
+5 SET BARBAL=$EXTRACT(^BARSTOPS($JOB,BARBL),27,34)
+6 SET BARBAL=$EXTRACT(BARBAL,1,($LENGTH(BARBAL)-2))_"."_$EXTRACT(BARBAL,($LENGTH(BARBAL)-1),$LENGTH(BARBAL))
+7 KILL DIC,DR,X,Y,DA
+8 SET DIC="^BARDEBT("
+9 SET DIC(0)="ZL"
+10 SET X=DT
+11 SET DIC("DR")=".02///^S X=BARBL"
+12 SET DIC("DR")=DIC("DR")_";.03///^S X=BARBAL"
+13 SET DIC("DR")=DIC("DR")_";.04////^S X=$E(^BARSTOPS($J,BARBL),26)"
+14 SET DIC("DR")=DIC("DR")_";.05////^S X=1"
+15 SET DIC("DR")=DIC("DR")_";.06////^S X=""I"""
+16 SET DIC("DR")=DIC("DR")_";.07///^S X=$$GET1^DIQ(90050.01,BARBL,3)"
+17 SET DIC("DR")=DIC("DR")_";.08///^S X=DUZ(2)"
+18 SET DIC("DR")=DIC("DR")_";.09///^S X=BARSIFN"
+19 SET DLAYGO=90050
+20 KILL DD,DO
+21 DO FILE^DICN
End DoDot:1
+22 KILL DIE,DIC,DR,DA,X,Y
+23 SET DIE="^BAR(90052.06,DUZ(2),"
+24 SET DA=DUZ(2)
+25 SET DR="1105////^S X=BARSTART"
+26 SET DR=DR_";1106////^S X=BAREND"
+27 DO ^DIE
+28 QUIT
+29 ; ********************************************************************
+30 ;
INACT ;
+1 ; Inactivate last entry for this bill
+2 SET BARLIEN=$ORDER(^BARDEBT("C",BARBL,"A"),-1)
+3 IF '+BARLIEN
QUIT
+4 SET DIE="^BARDEBT("
+5 SET DA=BARLIEN
+6 SET DR=".05////^S X=0"
+7 DO ^DIE
+8 QUIT
+9 ; ********************************************************************
+10 ;
LOGTSELF ; EP
+1 ; Log Self Pay Starts
+2 SET BARBL=0
+3 FOR
SET BARBL=$ORDER(^BARTSELF($JOB,BARBL))
IF '+BARBL
QUIT
Begin DoDot:1
+4 KILL DIC,DR,X,Y,DA
+5 SET DIC="^BARDEBT("
+6 SET DIC(0)="ZL"
+7 SET X=DT
+8 SET DIC("DR")=".02///^S X=BARBL"
+9 SET DIC("DR")=DIC("DR")_";.03///^S X=$$GET1^DIQ(90050.01,BARBL,15)"
+10 SET DIC("DR")=DIC("DR")_";.04////^S X=0"
+11 SET DIC("DR")=DIC("DR")_";.05////^S X=1"
+12 SET DIC("DR")=DIC("DR")_";.06////^S X=""S"""
+13 SET DIC("DR")=DIC("DR")_";.07///^S X=""SELF PAY"""
+14 SET DIC("DR")=DIC("DR")_";.08///^S X=DUZ(2)"
+15 SET DIC("DR")=DIC("DR")_";.09///^S X=BARTSFN"
+16 SET DLAYGO=90050
+17 KILL DD,DO
+18 DO FILE^DICN
+19 DO MSGTX(BARBL)
End DoDot:1
+20 ; Update current count and last start and stop in parameters
+21 KILL DIE,DIC,DR,DA,X,Y
+22 SET DIE="^BAR(90052.06,DUZ(2),"
+23 SET DA=DUZ(2)
+24 SET DR="1006///^S X=BARSCUR"
+25 SET DR=DR_";1105////^S X=BARSTART"
+26 SET DR=DR_";1106////^S X=BAREND"
+27 DO ^DIE
+28 QUIT
+29 ; ********************************************************************
+30 ;
LOGSTART ; EP
+1 ; Log Insurer Starts
+2 SET BARBL=0
+3 FOR
SET BARBL=$ORDER(^BARSTART($JOB,BARBL))
IF '+BARBL
QUIT
Begin DoDot:1
+4 KILL DIC,DR,X,Y,DA
+5 SET DIC="^BARDEBT("
+6 SET DIC(0)="ZL"
+7 SET X=DT
+8 SET DIC("DR")=".02///^S X=BARBL"
+9 SET DIC("DR")=DIC("DR")_";.03///^S X=$$GET1^DIQ(90050.01,BARBL,15)"
+10 SET DIC("DR")=DIC("DR")_";.04////^S X=0"
+11 SET DIC("DR")=DIC("DR")_";.05////^S X=1"
+12 SET DIC("DR")=DIC("DR")_";.06////^S X=""I"""
+13 SET DIC("DR")=DIC("DR")_";.07///^S X=$$GET1^DIQ(90050.01,BARBL,3)"
+14 SET DIC("DR")=DIC("DR")_";.08///^S X=DUZ(2)"
+15 SET DIC("DR")=DIC("DR")_";.09///^S X=BARTIFN"
+16 SET DLAYGO=90050
+17 KILL DD,DO
+18 DO FILE^DICN
+19 DO MSGTX(BARBL)
End DoDot:1
+20 ; Update current count and last start and stop in parameters
+21 KILL DIE,DIC,DR,DA,X,Y
+22 SET DIE="^BAR(90052.06,DUZ(2),"
+23 SET DA=DUZ(2)
+24 SET DR="1003///^S X=BARICUR"
+25 SET DR=DR_";1105////^S X=BARSTART"
+26 SET DR=DR_";1106////^S X=BAREND"
+27 DO ^DIE
+28 QUIT
+29 ; ********************************************************************
MSGTX(BARBL) ;
+1 ; Create message transaction on bills sent to Transworld w/ start code
+2 IF '+BARBL
QUIT
+3 SET BARTR=$$NEW^BARTR
+4 IF BARTR<1
QUIT
+5 SET BARTRDT=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+6 SET BARMSG="TRANSMITTED TO TRANSWORLD "_BARTRDT
+7 SET DA=BARTR
+8 SET DIE="^BARTR(DUZ(2),"
+9 SET DR="12////^S X=DT"
+10 SET DR=DR_";13////^S X=DUZ"
+11 SET DR=DR_";7////^S X=1"
+12 SET DR=DR_";4////^S X=BARBL"
+13 SET DR=DR_";10////^S X=$$GET1^DIQ(200,DUZ,29,""I"")"
+14 SET DR=DR_";16////^S X=""P"""
+15 SET DR=DR_";1001///^S X=BARMSG"
+16 DO ^DIE
+17 QUIT
