BAR18DSP ; IHS/SD/LSL - Convert BBMD Files to AR Files ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
; IHS/SD/LSL - Convert Debt Collection to AR
;
; ********************************************************************
Q
START ; EP
Q:'$D(^BBMDC(90119.7)) ; Debt Collection not installed
D PARAM ; convert Site Parameters
D PAYER ; convert Restricted Payers
D LOG ; convert Log file
Q
; ********************************************************************
;
PARAM ;
Q:$D(^BARTMP("1.8","SITE PARAM","STOP"))
W !!,"Converting Debt Collection Site Parameters to AR Site Parameters...",!!
S ^BARTMP("1.8","SITE PARAM","START")=$H
S BARHOLD=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^BBMDC(90119.7,DUZ(2))) Q:'+DUZ(2) D CONVERT
S DUZ(2)=BARHOLD
W !!,"DONE"
S ^BARTMP("1.8","SITE PARAM","STOP")=$H
Q
; ********************************************************************
;
CONVERT ;
Q:'$D(^BBMDC(90119.7,DUZ(2),0)) ; Just habit
S DIC="^BAR(90052.06,DUZ(2),"
S X=$$GET1^DIQ(90119.7,DUZ(2),.01)
S DIC(0)="EM"
K DD,DO
D ^DIC
I Y<1 D Q
. W !,"A/R Site Parameter not defined for ",$$GET1^DIQ(90119.7,DUZ(2),.01)
. W !,"Cannot convert Debt Collection Site Parameters."
S BARD0=$G(^BBMDC(90119.7,DUZ(2),0))
S BARD1=$G(^BBMDC(90119.7,DUZ(2),1))
S DIE=DIC
S DA=+Y
S DIDEL=90052
;
S DR=""
I $P(BARD0,U,2)]"" S DR=DR_";1001///^S X=$P(BARD0,U,2)" ;TSI ins #
I +$P(BARD0,U,10) S DR=DR_";1002///^S X=$P(BARD0,U,10)" ;max ins
I +$P(BARD1,U,3) S DR=DR_";1003///^S X=$P(BARD1,U,3)" ;ins tx's
I $P(BARD0,U,6)]"" S DR=DR_";1004///^S X=$P(BARD0,U,6)" ;TSI sp #
I +$P(BARD0,U,11) S DR=DR_";1005///^S X=$P(BARD0,U,11)" ;max sp
I +$P(BARD1,U,4) S DR=DR_";1006///^S X=$P(BARD1,U,4)" ;sp tx's
I $P(BARD0,U,3)]"" S DR=DR_";1007///^S X=$P(BARD0,U,3)" ;extr dir
I $P(BARD0,U,5)]"" S DR=DR_";1008///^S X=$P(BARD0,U,5)" ;Rpt dir
I $E(DR)=";" S DR=$E(DR,2,999)
D ^DIE
;
S DR=""
I +$P(BARD0,U,4) S DR=DR_";1101///^S X=$P(BARD0,U,4)" ;Min prnc
I +$P(BARD0,U,9) S DR=DR_";1102///^S X=$P(BARD0,U,9)" ;min age
I +$P(BARD0,U,7) S DR=DR_";1103///^S X=$P(BARD0,U,7)" ;early dos
I +$P(BARD0,U,8) S DR=DR_";1104///^S X=$P(BARD0,U,8)" ;erly srch
I +$P(BARD1,U) S DR=DR_";1105///^S X=$P(BARD1,U)" ;last frm
I +$P(BARD1,U,2) S DR=DR_";1106///^S X=$P(BARD1,U,2)" ;last to
I $E(DR)=";" S DR=$E(DR,2,999)
D ^DIE
;
;OLD INFORMATION NOT NEEDED FOR NEW SYSTEM
;S DR="1201///^S X=+$P(BARD0,U,13)" ;Auto?
;I +$P(BARD0,U,14) S DR=DR_";1202///^S X=$P(BARD0,U,14)" ;sch freq
;I +$P(BARD0,U,15) S DR=DR_";1203///^S X=$P(BARD0,U,15)" ;auto date
;I +$P(BARD1,U,5) S DR=DR_";1204///^S X=$P(BARD1,U,5)" ;cur task
;D ^DIE
Q
; ********************************************************************
; ********************************************************************
;
PAYER ;
; Convert payers for each Debt collection site defined.
Q:$D(^BARTMP("1.8","PAYER","STOP"))
W !!,"Converting Debt Collection Restricted Payers to AR Site Parameters...",!!
S ^BARTMP("1.8","PAYER","START")=$H
S BARHOLD=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^BBMDC(90119.7,DUZ(2))) Q:'+DUZ(2) D PAYER2
S DUZ(2)=BARHOLD
W !!,"DONE"
S ^BARTMP("1.8","PAYER","STOP")=$H
Q
; ********************************************************************
;
PAYER2 ;
W !
K DIC,DR,DA,DIE,X,Y
S X=$$GET1^DIQ(90119.7,DUZ(2),.01)
S DIC="^BAR(90052.06,DUZ(2),"
S DIC(0)="EM"
K DD,DO
D ^DIC
I Y<1 D Q
. W !,"A/R Site Parameter not defined for ",$$GET1^DIQ(90119.7,DUZ(2),.01)
. W !,"Cannot convert Debt Collection Restricted Payers."
S BARINS=0
F S BARINS=$O(^BBMDC(90119.9,BARINS)) Q:'+BARINS D PAYER3
Q
; ********************************************************************
;
PAYER3 ;
; This finds the insurer.
I '$D(^BARAC(DUZ(2),"B",BARINS_";AUTNINS(")) D Q
. W !!,"Insurer ",$$GET1^DIQ(9999999.18,BARINS,.01)," not found in A/R Account File. Cannot convert."
S BARAC=$O(^BARAC(DUZ(2),"B",BARINS_";AUTNINS(",0))
;S X=$$GET1^DIQ(90050.02,BARAC,.01)
;S X=+$$GET1^DIQ(90050.02,BARAC,.01,"I")
S X=BARAC
K DIC,DIE,DR,Y
S DA(1)=DUZ(2)
S DIC="^BAR(90052.06,DUZ(2),"_DA(1)_",13,"
S DLAYGO=90052
S DIC(0)="MQLZ"
S DIC("P")=$P(^DD(90052.06,1300,0),U,2)
S DIC("DR")=".02////^S X=$P(^BBMDC(90119.9,BARINS,0),U,2)"
K DD,DO
D FILE^DICN
I $P(Y,U,3)=1 Q ; If new entry quit
S DIE=DIC
S DR=".02////^S X=$P(^BBMDC(90119.9,BARINS,0),U,2)"
D ^DIE
Q
; ********************************************************************
;
LOG ;
; Convert Debt Collection Log File to A/R Debt Collection Log file
Q:$D(^BARTMP("1.8","LOG","STOP"))
W !!,"Converting Debt Collection Log File to AR Debt Collection Log file..."
S ^BARTMP("1.8","LOG","START")=$H
M ^BARDEBT=^BBMDC(90119.8)
S ^BARDEBT(0)="A/R DEBT COLLECTION LOG^90050.05D^"
S BARLOC=$O(^BBMDC(90119.7,0))
Q:'+BARLOC
S BARLIEN=0
S BARCNT=0
F S BARLIEN=$O(^BARDEBT(BARLIEN)) Q:'+BARLIEN D
. S BARCNT=BARCNT+1
. K X,Y,DR,DIE,DIC,DA
. S DIE="^BARDEBT("
. S DR=".08////^S X=BARLOC"
. S DA=BARLIEN
. D ^DIE
S $P(^BARDEBT(0),U,3)=DA
S $P(^BARDEBT(0),U,4)=BARCNT
W !!,"DONE"
S ^BARTMP("1.8","LOG","STOP")=$H
Q
BAR18DSP ; IHS/SD/LSL - Convert BBMD Files to AR Files ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - Convert Debt Collection to AR
+4 ;
+5 ; ********************************************************************
+6 QUIT
START ; EP
+1 ; Debt Collection not installed
IF '$DATA(^BBMDC(90119.7))
QUIT
+2 ; convert Site Parameters
DO PARAM
+3 ; convert Restricted Payers
DO PAYER
+4 ; convert Log file
DO LOG
+5 QUIT
+6 ; ********************************************************************
+7 ;
PARAM ;
+1 IF $DATA(^BARTMP("1.8","SITE PARAM","STOP"))
QUIT
+2 WRITE !!,"Converting Debt Collection Site Parameters to AR Site Parameters...",!!
+3 SET ^BARTMP("1.8","SITE PARAM","START")=$HOROLOG
+4 SET BARHOLD=DUZ(2)
+5 SET DUZ(2)=0
+6 FOR
SET DUZ(2)=$ORDER(^BBMDC(90119.7,DUZ(2)))
IF '+DUZ(2)
QUIT
DO CONVERT
+7 SET DUZ(2)=BARHOLD
+8 WRITE !!,"DONE"
+9 SET ^BARTMP("1.8","SITE PARAM","STOP")=$HOROLOG
+10 QUIT
+11 ; ********************************************************************
+12 ;
CONVERT ;
+1 ; Just habit
IF '$DATA(^BBMDC(90119.7,DUZ(2),0))
QUIT
+2 SET DIC="^BAR(90052.06,DUZ(2),"
+3 SET X=$$GET1^DIQ(90119.7,DUZ(2),.01)
+4 SET DIC(0)="EM"
+5 KILL DD,DO
+6 DO ^DIC
+7 IF Y<1
Begin DoDot:1
+8 WRITE !,"A/R Site Parameter not defined for ",$$GET1^DIQ(90119.7,DUZ(2),.01)
+9 WRITE !,"Cannot convert Debt Collection Site Parameters."
End DoDot:1
QUIT
+10 SET BARD0=$GET(^BBMDC(90119.7,DUZ(2),0))
+11 SET BARD1=$GET(^BBMDC(90119.7,DUZ(2),1))
+12 SET DIE=DIC
+13 SET DA=+Y
+14 SET DIDEL=90052
+15 ;
+16 SET DR=""
+17 ;TSI ins #
IF $PIECE(BARD0,U,2)]""
SET DR=DR_";1001///^S X=$P(BARD0,U,2)"
+18 ;max ins
IF +$PIECE(BARD0,U,10)
SET DR=DR_";1002///^S X=$P(BARD0,U,10)"
+19 ;ins tx's
IF +$PIECE(BARD1,U,3)
SET DR=DR_";1003///^S X=$P(BARD1,U,3)"
+20 ;TSI sp #
IF $PIECE(BARD0,U,6)]""
SET DR=DR_";1004///^S X=$P(BARD0,U,6)"
+21 ;max sp
IF +$PIECE(BARD0,U,11)
SET DR=DR_";1005///^S X=$P(BARD0,U,11)"
+22 ;sp tx's
IF +$PIECE(BARD1,U,4)
SET DR=DR_";1006///^S X=$P(BARD1,U,4)"
+23 ;extr dir
IF $PIECE(BARD0,U,3)]""
SET DR=DR_";1007///^S X=$P(BARD0,U,3)"
+24 ;Rpt dir
IF $PIECE(BARD0,U,5)]""
SET DR=DR_";1008///^S X=$P(BARD0,U,5)"
+25 IF $EXTRACT(DR)=";"
SET DR=$EXTRACT(DR,2,999)
+26 DO ^DIE
+27 ;
+28 SET DR=""
+29 ;Min prnc
IF +$PIECE(BARD0,U,4)
SET DR=DR_";1101///^S X=$P(BARD0,U,4)"
+30 ;min age
IF +$PIECE(BARD0,U,9)
SET DR=DR_";1102///^S X=$P(BARD0,U,9)"
+31 ;early dos
IF +$PIECE(BARD0,U,7)
SET DR=DR_";1103///^S X=$P(BARD0,U,7)"
+32 ;erly srch
IF +$PIECE(BARD0,U,8)
SET DR=DR_";1104///^S X=$P(BARD0,U,8)"
+33 ;last frm
IF +$PIECE(BARD1,U)
SET DR=DR_";1105///^S X=$P(BARD1,U)"
+34 ;last to
IF +$PIECE(BARD1,U,2)
SET DR=DR_";1106///^S X=$P(BARD1,U,2)"
+35 IF $EXTRACT(DR)=";"
SET DR=$EXTRACT(DR,2,999)
+36 DO ^DIE
+37 ;
+38 ;OLD INFORMATION NOT NEEDED FOR NEW SYSTEM
+39 ;S DR="1201///^S X=+$P(BARD0,U,13)" ;Auto?
+40 ;I +$P(BARD0,U,14) S DR=DR_";1202///^S X=$P(BARD0,U,14)" ;sch freq
+41 ;I +$P(BARD0,U,15) S DR=DR_";1203///^S X=$P(BARD0,U,15)" ;auto date
+42 ;I +$P(BARD1,U,5) S DR=DR_";1204///^S X=$P(BARD1,U,5)" ;cur task
+43 ;D ^DIE
+44 QUIT
+45 ; ********************************************************************
+46 ; ********************************************************************
+47 ;
PAYER ;
+1 ; Convert payers for each Debt collection site defined.
+2 IF $DATA(^BARTMP("1.8","PAYER","STOP"))
QUIT
+3 WRITE !!,"Converting Debt Collection Restricted Payers to AR Site Parameters...",!!
+4 SET ^BARTMP("1.8","PAYER","START")=$HOROLOG
+5 SET BARHOLD=DUZ(2)
+6 SET DUZ(2)=0
+7 FOR
SET DUZ(2)=$ORDER(^BBMDC(90119.7,DUZ(2)))
IF '+DUZ(2)
QUIT
DO PAYER2
+8 SET DUZ(2)=BARHOLD
+9 WRITE !!,"DONE"
+10 SET ^BARTMP("1.8","PAYER","STOP")=$HOROLOG
+11 QUIT
+12 ; ********************************************************************
+13 ;
PAYER2 ;
+1 WRITE !
+2 KILL DIC,DR,DA,DIE,X,Y
+3 SET X=$$GET1^DIQ(90119.7,DUZ(2),.01)
+4 SET DIC="^BAR(90052.06,DUZ(2),"
+5 SET DIC(0)="EM"
+6 KILL DD,DO
+7 DO ^DIC
+8 IF Y<1
Begin DoDot:1
+9 WRITE !,"A/R Site Parameter not defined for ",$$GET1^DIQ(90119.7,DUZ(2),.01)
+10 WRITE !,"Cannot convert Debt Collection Restricted Payers."
End DoDot:1
QUIT
+11 SET BARINS=0
+12 FOR
SET BARINS=$ORDER(^BBMDC(90119.9,BARINS))
IF '+BARINS
QUIT
DO PAYER3
+13 QUIT
+14 ; ********************************************************************
+15 ;
PAYER3 ;
+1 ; This finds the insurer.
+2 IF '$DATA(^BARAC(DUZ(2),"B",BARINS_";AUTNINS("))
Begin DoDot:1
+3 WRITE !!,"Insurer ",$$GET1^DIQ(9999999.18,BARINS,.01)," not found in A/R Account File. Cannot convert."
End DoDot:1
QUIT
+4 SET BARAC=$ORDER(^BARAC(DUZ(2),"B",BARINS_";AUTNINS(",0))
+5 ;S X=$$GET1^DIQ(90050.02,BARAC,.01)
+6 ;S X=+$$GET1^DIQ(90050.02,BARAC,.01,"I")
+7 SET X=BARAC
+8 KILL DIC,DIE,DR,Y
+9 SET DA(1)=DUZ(2)
+10 SET DIC="^BAR(90052.06,DUZ(2),"_DA(1)_",13,"
+11 SET DLAYGO=90052
+12 SET DIC(0)="MQLZ"
+13 SET DIC("P")=$PIECE(^DD(90052.06,1300,0),U,2)
+14 SET DIC("DR")=".02////^S X=$P(^BBMDC(90119.9,BARINS,0),U,2)"
+15 KILL DD,DO
+16 DO FILE^DICN
+17 ; If new entry quit
IF $PIECE(Y,U,3)=1
QUIT
+18 SET DIE=DIC
+19 SET DR=".02////^S X=$P(^BBMDC(90119.9,BARINS,0),U,2)"
+20 DO ^DIE
+21 QUIT
+22 ; ********************************************************************
+23 ;
LOG ;
+1 ; Convert Debt Collection Log File to A/R Debt Collection Log file
+2 IF $DATA(^BARTMP("1.8","LOG","STOP"))
QUIT
+3 WRITE !!,"Converting Debt Collection Log File to AR Debt Collection Log file..."
+4 SET ^BARTMP("1.8","LOG","START")=$HOROLOG
+5 MERGE ^BARDEBT=^BBMDC(90119.8)
+6 SET ^BARDEBT(0)="A/R DEBT COLLECTION LOG^90050.05D^"
+7 SET BARLOC=$ORDER(^BBMDC(90119.7,0))
+8 IF '+BARLOC
QUIT
+9 SET BARLIEN=0
+10 SET BARCNT=0
+11 FOR
SET BARLIEN=$ORDER(^BARDEBT(BARLIEN))
IF '+BARLIEN
QUIT
Begin DoDot:1
+12 SET BARCNT=BARCNT+1
+13 KILL X,Y,DR,DIE,DIC,DA
+14 SET DIE="^BARDEBT("
+15 SET DR=".08////^S X=BARLOC"
+16 SET DA=BARLIEN
+17 DO ^DIE
End DoDot:1
+18 SET $PIECE(^BARDEBT(0),U,3)=DA
+19 SET $PIECE(^BARDEBT(0),U,4)=BARCNT
+20 WRITE !!,"DONE"
+21 SET ^BARTMP("1.8","LOG","STOP")=$HOROLOG
+22 QUIT
