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