Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BAR18DSP

BAR18DSP.m

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