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

IBCNBMI.m

Go to the documentation of this file. 
  1. IBCNBMI ;ALB/ARH/AWC - Ins Buffer: move buffer data to insurance files ;09 Mar 2005  11:42 AM
  1.  ;;2.0;INTEGRATED BILLING;**82,184,246,251,299,345,361,371,413,416,438,452,497,528**;21-MAR-94;Build 163
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. INS(IBBUFDA,IBINSDA,TYPE,RESULT) ;  move buffer insurance company data (file 355.33) to existing Insurance Company (file 36)
  1.  ;
  1.  S IBBUFDA=IBBUFDA_",",IBINSDA=$G(IBINSDA)_","
  1.  D SET("INS",IBBUFDA,IBINSDA,TYPE,.RESULT)
  1.  Q
  1.  ;
  1. GRP(IBBUFDA,IBGRPDA,TYPE,RESULT) ;  move buffer insurance group/plan data (file 355.33) to existing Group/Plan (file 355.3)
  1.  ;
  1.  S IBBUFDA=IBBUFDA_",",IBGRPDA=$G(IBGRPDA)_","
  1.  D SET("GRP",IBBUFDA,IBGRPDA,TYPE,.RESULT)
  1.  D STUFF("GRP",IBGRPDA,.RESULT)
  1.  Q
  1.  ;
  1. POLICY(IBBUFDA,IBPOLDA,TYPE,RESULT) ; called from routine PROCESS^IBCNBAR
  1.  ; move buffer insurance policy data (file 355.33) to existing Patient Policy (file 2.312)
  1.  ;
  1.  N DFN S DFN=+$G(^IBA(355.33,+$G(IBBUFDA),60)) Q:'DFN
  1.  ;
  1.  S IBBUFDA=IBBUFDA_",",IBPOLDA=$G(IBPOLDA)_","_DFN_","
  1.  D SET("POL",IBBUFDA,IBPOLDA,TYPE,.RESULT)
  1.  D STUFF("POL",IBPOLDA,.RESULT)
  1.  D POLOTH(IBBUFDA,IBPOLDA,.RESULT)
  1.  Q
  1.  ;
  1. SUB(IBBUFDA,IBPOLDA,IBRIEN,IBSEL,IBTYPE,IBRESULT,DFN,IBFNAM,IBVAL,IBHOLD,IBXHOLD) ;  move patient data(file #2) <or> income person data(408.13) to existing Patient Policy (file 2.312)
  1.  D SUB^IBCNBCD6(IBBUFDA,IBPOLDA,IBRIEN,IBSEL,IBTYPE,.IBRESULT,DFN,IBFNAM,IBVAL,.IBHOLD,.IBXHOLD)
  1.  Q
  1.  ;
  1. SET(SET,IBBUFDA,IBEXTDA,TYPE,RESULT) ; move buffer data to insurance files
  1.  ; Input:  IBBUFDA - ifn of Buffer File entry to move (#355.33)
  1.  ;         IBEXTDA - ifn of insurance entry to update (#36,355.3,2)
  1.  ;         TYPE    - 1 = Merge     (only buffer data moved to blank fields in ins file, no replace)
  1.  ;                   2 = Overwrite (all buffer data moved to ins file, replace existing data)
  1.  ;                   3 = Replace (all buffer data including null move to ins file)
  1.  ;                   4 = Individually Accept (Skip Blanks) (user accepts
  1.  ;  individual diffs b/w buffer data and existing file data (excl blanks)
  1.  ;  to overwrite flds (or addr grp) in existing file)
  1.  ; Output: RESULT - Passed array to return FM error message if there are
  1.  ;                  errors when filing the buffer data
  1.  ;
  1.  N IBX,IBFLDS,EXTFILE,DRBUF,DREXT,BUFARR,EXTARR,IBBUFFLD,IBEXTFLD,IBBUFVAL,IBEXTVAL,IBCHNG,IBCHNGN,IBERR
  1.  ;
  1.  D FIELDS(SET_"FLD")
  1.  S IBX=$P($T(@(SET_"DR")+1),";;",2),EXTFILE=+$P(IBX,U,1),DRBUF=$P(IBX,U,2),DREXT=$P(IBX,U,3)
  1.  ;
  1.  D GETS^DIQ(355.33,IBBUFDA,DRBUF,"E","BUFARR")
  1.  D GETS^DIQ(EXTFILE,IBEXTDA,DREXT,"E","EXTARR")
  1.  ;
  1.  I +$G(TYPE) S IBBUFFLD=0 F  S IBBUFFLD=$O(BUFARR(355.33,IBBUFDA,IBBUFFLD)) Q:'IBBUFFLD  D
  1.  . ;If not called by ACCEPAPI^IBCNICB API, don't update from these 
  1.  . ;fields:
  1.  . ;   Insurance Company Name - #20.01, Reimburse? - 20.05
  1.  . ;   Is this a Group Policy - #40.01
  1.  . I $G(IBSUPRES)'>0,"^20.01^20.05^40.01^"[("^"_IBBUFFLD_"^") Q
  1.  . ;
  1.  . S IBEXTFLD=$G(IBFLDS(IBBUFFLD)) Q:'IBEXTFLD
  1.  . S IBBUFVAL=BUFARR(355.33,IBBUFDA,IBBUFFLD,"E")
  1.  . S IBEXTVAL=$G(EXTARR(EXTFILE,IBEXTDA,IBEXTFLD,"E"))
  1.  . ;
  1.  . I IBBUFVAL=IBEXTVAL Q
  1.  . I TYPE=1,IBEXTVAL'="" Q
  1.  . I TYPE=2,IBBUFVAL="" Q
  1.  . I TYPE=4,'$D(^TMP($J,"IB BUFFER SELECTED",IBBUFFLD)) Q
  1.  . ;
  1.  . S IBCHNG(EXTFILE,IBEXTDA,IBEXTFLD)=IBBUFVAL
  1.  . ;For ACCEPAPI^IBCNICB do not delete the .01 field. This prevents a
  1.  . ;Data Dictionary Deletion Write message
  1.  . Q:IBEXTFLD=".01"
  1.  . S IBCHNGN(EXTFILE,IBEXTDA,IBEXTFLD)=""
  1.  ;
  1.  I $D(IBCHNGN)>9 D FILE^DIE("E","IBCHNGN","IBERR")
  1.  ;Removed delete errors and move FM errors to RESULT
  1.  D:$D(IBERR)>0 REMOVDEL(.IBERR),EHANDLE(SET,.IBERR,.RESULT)
  1.  K IBERR
  1.  I $D(IBCHNG)>9 D FILE^DIE("E","IBCHNG","IBERR")
  1.  ;Move FM errors to RESULT
  1.  D:$D(IBERR)>0 EHANDLE(SET,.IBERR,.RESULT)
  1.  Q
  1.  ;
  1. STUFF(SET,IBEXTDA,RESULT) ; update fields in insurance files that 
  1.  ;should be automatically set when an entry is edited
  1.  ; Input:  IBEXTDA - ifn of insurance entry to update (#36,356,2)
  1.  ; Output: RESULT - Passed array to return FM error message if there are
  1.  ;                  errors when filing the data buffer data
  1.  ;
  1.  N IBX,IBFLDS,EXTFILE,IBEXTFLD,IBEXTVAL,IBCHNG,IBCHNGN,IBERR
  1.  ;
  1.  D FIELDS(SET_"A")
  1.  S IBX=$P($T(@(SET_"DR")+1),";;",2),EXTFILE=+$P(IBX,U,1)
  1.  ;
  1.  S IBEXTFLD=0 F  S IBEXTFLD=$O(IBFLDS(IBEXTFLD)) Q:'IBEXTFLD  D
  1.  . S IBEXTVAL=IBFLDS(IBEXTFLD) I IBEXTVAL="DUZ" S IBEXTVAL="`"_DUZ
  1.  . S IBCHNG(EXTFILE,IBEXTDA,IBEXTFLD)=IBEXTVAL
  1.  . S IBCHNGN(EXTFILE,IBEXTDA,IBEXTFLD)=""
  1.  ;
  1.  D FILE^DIE("E","IBCHNGN","IBERR")
  1.  ;Move FM errors to RESULT
  1.  D:$D(IBERR)>0 EHANDLE(SET,.IBERR,.RESULT)
  1.  K IBERR
  1.  D FILE^DIE("E","IBCHNG","IBERR")
  1.  ;Move FM errors to RESULT
  1.  D:$D(IBERR)>0 EHANDLE(SET,.IBERR,.RESULT)
  1.  Q
  1.  ;
  1. FIELDS(SET) ; return array of corresponding fields: IBFLDS(Buffer #)=Ins #
  1.  N IBI,IBLN,IBB,IBE,IBG K IBFLDS,IBADDS,IBLBLS
  1.  F IBI=1:1 S IBLN=$P($T(@(SET)+IBI),";;",2) Q:IBLN=""  I $E(IBLN,1)'=" " D
  1.  . S IBB=$P(IBLN,U,1),IBE=$P(IBLN,U,2),IBG=$P(IBLN,U,4)
  1.  . I IBB'="",IBE'="" D
  1.  .. S IBFLDS(IBB)=IBE
  1.  .. I SET["FLD" S IBLBLS(IBB)=$P(IBLN,U,3) I +IBG S IBADDS(IBB)=IBE
  1.  Q
  1.  ;
  1. INSDR ;
  1.  ;;36^20.01:20.05;21.01:21.06^.01;.131;.132;.133;.111:.116;1
  1. INSFLD ; corresponding fields: Buffer File (355.33) & Insurance Company file (36)
  1.  ;;20.01^.01^Insurance Company Name^  ; Name
  1.  ;;20.02^.131^Phone Number^           ; MM Phone Number
  1.  ;;20.03^.132^Billing Phone^          ; Billing Phone Number
  1.  ;;20.04^.133^Pre-Cert Phone^         ; Pre-Certification Phone Number
  1.  ;;20.05^1^Reimburse?^                ; Will Reimburse?
  1.  ;;21.01^.111^Street [Line 1]^1       ; MM Street Address [Line 1]
  1.  ;;21.02^.112^Street [Line 2]^1       ; MM Street Address [Line 2]
  1.  ;;21.03^.113^Street [Line 3]^1       ; MM Street Address [Line 3]
  1.  ;;21.04^.114^City^1                  ; MM City
  1.  ;;21.05^.115^State^1                 ; MM State
  1.  ;;21.06^.116^Zip^1                   ; MM Zip Code
  1.  ;
  1. GRPDR ;
  1.  ;;355.3^40.01;90.01;90.02;40.04:40.09;40.1;40.11;^.02;2.01;2.02;.05:.09;6.02;6.03;.12
  1. GRPFLD ;corresponding fields:  Buffer File (355.33) and Insurance Group Plan file (355.3)
  1.  ;;40.01^.02^Is This a Group Policy?^ ; Is this a Group Policy?
  1.  ;;90.01^2.01^Group Name^              ; Group Name
  1.  ;;90.02^2.02^Group Number^            ; Group Number
  1.  ;;40.1^6.02^BIN^                     ; BIN ;;Daou/EEN
  1.  ;;40.11^6.03^PCN^                    ; PCN ;;Daou/EEN
  1.  ;;40.04^.05^Require UR^              ; Utilization Review Required
  1.  ;;40.05^.06^Require Pre-Cert^        ; Pre-Certification Required
  1.  ;;40.06^.12^Require Amb Cert^        ; Ambulatory Care Certification
  1.  ;;40.07^.07^Exclude Pre-Cond^        ; Exclude Pre-Existing Conditions
  1.  ;;40.08^.08^Benefits Assign^         ; Benefits Assignable
  1.  ;;40.09^.09^Type of Plan^            ; Type of Plan
  1.  ;
  1. GRPA ; auto set fields
  1.  ;;1.05^NOW^                          ; Date Last Edited
  1.  ;;1.06^DUZ^                          ; Last edited By
  1.  ;
  1. POLDR ;
  1.  ;;2.312^60.02;60.03;90.03;60.05;60.06;91.01;60.08:62.09^8;3;7.02;6;16;7.01;3.01;3.05:3.1;3.11;3.13;3.14;4.01;4.02;4.05;4.06;.2;3.12;2.1;2.015;2.11;2.12;2.01:2.08;5.01
  1. POLFLD ; corresponding fields:  Buffer File (355.33) and Insurance Patient Policy file (2.312)
  1.  ;;60.02^8^Effective Date^            ; Effective Date
  1.  ;;60.03^3^Expiration Date^           ; Expiration Date
  1.  ;;90.03^7.02^Subscriber Id^             ; Subscriber Id
  1.  ;;60.05^6^Whose Insurance^           ; Whose Insurance
  1.  ;;60.06^16^Relationship^             ; Pt. Relationship to Insured
  1.  ;;91.01^7.01^Name of Insured^          ; Name of Insured
  1.  ;;60.08^3.01^Insured's DOB^          ; Insured's DOB
  1.  ;;60.09^3.05^Insured's SSN^          ; Insured's SSN
  1.  ;;60.1^4.01^Primary Provider^        ; Primary Care Provider
  1.  ;;60.11^4.02^Provider Phone^         ; Primary Care Provider Phone
  1.  ;;60.12^.2^Coor of Benefits^         ; Coordination of Benefits
  1.  ;;60.13^3.12^Insured's Sex^          ; Insured's Sex
  1.  ;;60.15^4.05^Rx Relationship^        ; Pharmacy Relationship Code  IB*2*452
  1.  ;;60.16^4.06^Rx Person Code^         ; Pharmacy Person Code        IB*2*452
  1.  ;;  
  1.  ;;61.01^2.1^Emp Sponsored^           ; ESGHP?
  1.  ;;61.02^2.015^Employer Name^         ; Subscriber's Employer Name
  1.  ;;61.03^2.11^Emp Status^             ; Employment Status
  1.  ;;61.04^2.12^Retirement Date^        ; Retirement Date
  1.  ;;61.05^2.01^Send to Employer^       ; Send Bill to Employer?
  1.  ;;61.06^2.02^Emp Street Ln 1^1       ; Employer Claims Street Line 1
  1.  ;;61.07^2.03^Emp Street Ln 2^1       ; Employer Claims Street Line 2
  1.  ;;61.08^2.04^Emp Street Ln 3^1       ; Employer Claims Street Line 3
  1.  ;;61.09^2.05^Emp City^1              ; Employer Claims City
  1.  ;;61.1^2.06^Emp State^1              ; Employer Claims State
  1.  ;;61.11^2.07^Emp Zip Code^1          ; Employer Claims Zip Code
  1.  ;;61.12^2.08^Emp Phone^              ; Employer Claims Phone
  1.  ;;62.01^5.01^Patient Id^             ; Patient Id
  1.  ;;62.02^3.06^Subscr Addr Ln 1^       ; Subscriber Address Line 1
  1.  ;;62.03^3.07^Subscr Addr Ln 2^       ; Subscriber Address Line 2
  1.  ;;62.04^3.08^Subscr City^            ; Subscriber City
  1.  ;;62.05^3.09^Subscr State^           ; Subscriber State
  1.  ;;62.06^3.1^Subscr Zip^              ; Subscriber Zip Code
  1.  ;;62.09^3.11^Subscr Phone^           ; Subscriber Phone Number  IB*2.0*528
  1.  ;;62.07^3.13^Subscr Country^         ; Subscriber Country Code
  1.  ;;62.08^3.14^Subscr Cntry Div^       ; Subscriber Country Subdivision Code
  1.  ;
  1. POLA ; auto set fields
  1.  ;;1.03^NOW^                          ; Date Last Verified (default is person that accepts entry)
  1.  ;;1.04^DUZ^                          ; Verified By        (default is person that accepts entry)
  1.  ;;1.05^NOW^                          ; Date Last Edited
  1.  ;;1.06^DUZ^                          ; Last Edited By
  1.  ;
  1. POLOTH(IBBUFDA,IBPOLDA,RESULT) ; other special cases that can not be transferred using the generic code above, usually because of dependencies
  1.  N IBERR,IB0 S IB0=$G(^IBA(355.33,+IBBUFDA,0))
  1.  ;
  1.  ;  --- if buffer entry was verified before the accept step, then add the correct verifier info to the policy
  1.  I +$P(IB0,U,10) D
  1.  . S IBCHNG(2.312,IBPOLDA,1.03)=$E($P(IB0,U,10),1,12),IBCHNGN(2.312,IBPOLDA,1.03)=""
  1.  . S IBCHNG(2.312,IBPOLDA,1.04)=$P(IB0,U,11),IBCHNGN(2.312,IBPOLDA,1.04)=""
  1.  ;
  1.  I $D(IBCHNGN)>9 D FILE^DIE("I","IBCHNGN","IBERR")
  1.  ;Move FM errors to RESULT
  1.  D:$D(IBERR)>0 EHANDLE("POL",.IBERR,.RESULT)
  1.  K IBERR
  1.  I $D(IBCHNG)>9 D FILE^DIE("I","IBCHNG","IBERR")
  1.  ;Move FM errors to RESULT
  1.  D:$D(IBERR)>0 EHANDLE("POL",.IBERR,.RESULT)
  1.  Q
  1.  ;
  1. PAT(DFN,IBPOLDA) ; Force DOB, SSN & SEX from Patient file (#2) in to Insurance Patient Policy file (2.312)
  1.  N DA,DR,DIE,DOB,SSN,SEX,IENS,WI
  1.  S IENS=IBPOLDA_","_DFN_","
  1.  S WI=$$GET1^DIQ(2.312,IENS,6,"I")
  1.  I WI'="v" Q  ; Only use when Whose Insurance is 'v'
  1.  S DOB=$$GET1^DIQ(2,DFN,.03,"I")
  1.  S SSN=$$GET1^DIQ(2,DFN,.09,"I")
  1.  S SEX=$$GET1^DIQ(2,DFN,.02,"I")
  1.  S DIE="^DPT("_DFN_",.312,",DA(1)=DFN,DA=IBPOLDA
  1.  S DR="3.01///^S X=DOB;3.05///^S X=SSN;3.12///^S X=SEX"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. EHANDLE(SET,FMERR,RESULT) ;
  1.  ;Fileman Error Processing tracking added for ACCEPAPI^IBCNICB API.
  1.  ; INPUT: 
  1.  ;   SET    - File where fileman error occurred
  1.  ;       Value = "INS" --> File 36    --> RESULT(1)
  1.  ;       Value = "GRP" --> File 355.3 --> RESULT(2)
  1.  ;       Value = "POL" --> File 2.312 --> RESULT(3)
  1.  ;   FMERR  - Array that is returned by FM with error messages
  1.  ; OUTPUT:
  1.  ;   RESULT - Passed array to return FM error message if there are
  1.  ;            errors when filing the data buffer data
  1.  ;
  1.  Q:$G(SET)']""!($D(FMERR)'>0)
  1.  N SUB1,RNUM,ERRNUM,LINENUM
  1.  ;Numeric 1st subscript of RESULT array based on file being updated
  1.  ;File 36 = 1, 355.3 = 2, 2.312 = 3 
  1.  S SUB1=$S(SET="INS":1,SET="GRP":2,SET="POL":3,1:"")
  1.  ;Quit if SUB1 doesn't have a value.
  1.  Q:SUB1']""
  1.  S RNUM=$O(RESULT(SUB1,"ERR",9999999999),-1),ERRNUM=0
  1.  F  S ERRNUM=$O(FMERR("DIERR",ERRNUM)) Q:+ERRNUM'>0  D
  1.  . S LINENUM=0
  1.  . F  S LINENUM=$O(FMERR("DIERR",ERRNUM,"TEXT",LINENUM)) Q:+LINENUM'>0  D
  1.  . . S RNUM=RNUM+1
  1.  . . S RESULT(SUB1,"ERR",RNUM)=FMERR("DIERR",ERRNUM,"TEXT",LINENUM)
  1.  Q
  1.  ;
  1. REMOVDEL(FMERR) ;
  1.  ;Removed field delete errors. SET and STUFF API delete data first and
  1.  ;then update with new data from Insurance Buffer file. Error Code 712
  1.  ;"Deletion was attempted but not allowed" errors will be removed from
  1.  ;the returned FM error array 
  1.  ; INPUT/OUTPUT:
  1.  ;   FMERR  - Array that is returned by FM with error messages
  1.  ;
  1.  Q:$D(FMERR)'>0
  1.  N ERRNUM
  1.  S ERRNUM=0
  1.  F  S ERRNUM=$O(FMERR("DIERR",ERRNUM)) Q:+ERRNUM'>0  D
  1.  . I FMERR("DIERR",ERRNUM)=712 K FMERR("DIERR",ERRNUM)
  1.  Q