Routine: IBCNBCD6

IBCNBCD6 ;ALB/AWC - MCCF FY14 Subscriber Display Screens ;25 Feb 2015

 ;;2.0;INTEGRATED BILLING;**528**;21-MAR-94;Build 163

 ;;Per VA Directive 6402, this routine should not be modified.

 ;Input Parameters:

 ;  See routine IBCNBCD1

SUB(IBBUFDA,IBEXTDA,IBRIEN,IBSEL,IBTYPE,IBRESULT,DFN,IBFNAM,IBVAL,IBHOLD,IBXHOLD) ; called from routine SUB^IBCMBMI

 ; Move patient data(file #2) <or> income person data(408.13) into existing Patient Policy (file 2.312)

 N IBX,IBSET,IBXFILE,BUFARR,EXTARR,IBFLDS,IBLBLS,IBADDS,IBDRB,IBDRX,IBERR,IBCHNG,IBCHNGN,IBBFDA

 S IBBFDA=IBBUFDA_","

 S IBEXTDA=$G(IBEXTDA)_","_DFN_","

 I IBSEL=18 D

 . I IBFNAM="DPT" S IBSET="DPT" D SELF(IBSET,IBBFDA,IBRIEN,IBEXTDA,IBTYPE,.BUFARR,.EXTARR,.IBCHNG,.IBCHNGN,.IBFLDS,.IBLBLS,.IBADDS,.IBRESULT,.IBHOLD,.IBXHOLD)

 ; -- if user selected "spouse" use income person file(#408.13) to get specific data/fields

 I IBSEL=1 D

 . I IBFNAM="DGPR" S IBSET="DGPR" D SPOUSE(IBSET,IBBFDA,IBRIEN,IBEXTDA,IBTYPE,.BUFARR,.EXTARR,.IBCHNG,.IBCHNGN,.IBFLDS,.IBLBLS,.IBADDS,.IBRESULT,.IBHOLD,.IBXHOLD) Q

 . I IBFNAM']"" S IBSET="N" D NSPOUSE(IBSET,IBBFDA,IBRIEN,IBEXTDA,IBTYPE,.BUFARR,.EXTARR,.IBCHNG,.IBCHNGN,.IBFLDS,.IBLBLS,.IBADDS,.IBRESULT,.IBHOLD,.IBXHOLD)

 ; -- update policy fields with nulls

 I $D(IBCHNGN)>9 D FILE^DIE("E","IBCHNGN","IBERR") I $D(IBERR) W !,"Error... SUB-IBCNBCD6  Could not file fields with nulls" K DIR D PAUSE^VALM1 Q

 ; -- update policy fields with data

 I $D(IBCHNG)>9 D FILE^DIE("E","IBCHNG","IBERR") I $D(IBERR)>0 W !,"Error... SUB-IBCNBCD6  Could not file fields with data" K DIR D PAUSE^VALM1 Q

 ; -- update policy fields with user information

 D STUFF("POL",IBEXTDA,.IBRESULT)

 ; -- update policy with verified-by information

 D POLOTH(IBBFDA,IBEXTDA,.IBRESULT)

SELF(IBSET,IBBUFDA,IBRIEN,IBEXTDA,IBTYPE,BUFARR,EXTARR,IBCHNG,IBCHNGN,IBFLDS,IBLBLS,IBADDS,IBRESULT,IBHOLD,IBXHOLD) ; get data for "self" relationship

 N IBX,IB1,IB2,IBXARY,IBFARY,IBDRB,IBDRX,IBBUFVAL,IBEXTFLD,IBEXTVAL,IBXFILE

 ; -- get corresponding fields to populate data

 D FIELDS(IBSET_"FLD",.IBFLDS,.IBLBLS,.IBADDS)

 S IBX=$P($T(@(IBSET_"DR")+1),";;",2),IBXFILE=+$P(IBX,U,1),IBDRB=$P(IBX,U,2),IBDRX=$P(IBX,U,3)

 I +$G(IBTYPE) F IBX=1:1:$L(IBDRB,";") D

. ;

 . S IB1=$P(IBDRB,";",IBX),IB2=$P(IBDRX,";",IBX)

. ;

 . S IBBUFVAL=$G(@IBHOLD@(2,IB1)),IBEXTVAL=$G(@IBXHOLD@(2,IB2))

. ;

 . I IBBUFVAL=IBEXTVAL Q

 . I IBTYPE=1,IBEXTVAL'="" Q

 . I IBTYPE=2,IBBUFVAL="" Q

 . I IBTYPE=4,'$D(^TMP($J,"IB BUFFER SELECTED",IB1)) Q

. ;

. ;

 . S IBCHNG(IBXFILE,IBEXTDA,IB2)=IBBUFVAL

. ;

 . ; -- for ACCEPAPI^IBCNICB do not delete the .01 field. This prevents a Data Dictionary Deletion Write message

 . Q:IB2=".01"!(IB2="4.03")!(IB2="6")!(IB2="7.01")

. ;

 . S IBCHNGN(IBXFILE,IBEXTDA,IB2)=""

SPOUSE(IBSET,IBBUFDA,IBRIEN,IBEXTDA,IBTYPE,BUFARR,EXTARR,IBCHNG,IBCHNGN,IBFLDS,IBLBLS,IBADDS,IBRESULT,IBHOLD,IBXHOLD) ; get data for "spouse" relationship

 N IBX,IBXARY,IBFARY,IBDRB,IBDRX,IBBUFVAL,IBEXTFLD,IBEXTVAL,IBXFILE

 ; -- get corresponding fields to populate data

 D FIELDS(IBSET_"FLD",.IBFLDS,.IBLBLS,.IBADDS)

 S IBX=$P($T(@(IBSET_"DR")+1),";;",2),IBXFILE=+$P(IBX,U,1),IBDRB=$P(IBX,U,2),IBDRX=$P(IBX,U,3)

 I +$G(IBTYPE) F IBX=1:1:$L(IBDRB,";") D

. ;

 . S IB1=$P(IBDRB,";",IBX),IB2=$P(IBDRX,";",IBX)

. ;

 . S IBBUFVAL=$G(@IBHOLD@(2,IB1)),IBEXTVAL=$G(@IBXHOLD@(2,IB2))

. ;

 . I IBBUFVAL=IBEXTVAL Q

 . I IBTYPE=1,IBEXTVAL'="" Q

 . I IBTYPE=2,IBBUFVAL="" Q

 . I IBTYPE=4,'$D(^TMP($J,"IB BUFFER SELECTED",IB1)) Q

. ;

 . S IBCHNG(IBXFILE,IBEXTDA,IB2)=IBBUFVAL

. ;

 . ; -- for ACCEPAPI^IBCNICB do not delete the .01 field. This prevents a Data Dictionary Deletion Write message

 . Q:IB2=".01"!(IB2="4.03")!(IB2="6")!(IB2="7.01")

. ;

 . S IBCHNGN(IBXFILE,IBEXTDA,IB2)=""

NSPOUSE(IBSET,IBBFDA,IBRIEN,IBEXTDA,IBTYPE,BUFARR,EXTARR,IBCHNG,IBCHNGN,IBFLDS,IBLBLS,IBADDS,IBRESULT,IBHOLD,IBXHOLD) ; no spuse data

 N IBX,IBXARY,IBFARY,IBDRB,IBDRX,IBBUFVAL,IBEXTFLD,IBEXTVAL,IBXFILE

 ; -- left side of screen get data from income person(#408.13) fields

 D FIELDS(IBSET_"FLD",.IBFLDS,.IBLBLS,.IBADDS)

 S IBX=$P($T(@(IBSET_"DR")+1),";;",2),IBXFILE=+$P(IBX,U,1),IBDRB=$P(IBX,U,2),IBDRX=$P(IBX,U,3)

 I +$G(IBTYPE) F IBX=1:1:$L(IBDRB,";") D

. ;

 . S IB1=$P(IBDRB,";",IBX),IB2=$P(IBDRX,";",IBX)

. ;

 . S IBBUFVAL=$G(@IBHOLD@(2,IB1)),IBEXTVAL=$G(@IBXHOLD@(2,IB2))

. ;

 . I IBBUFVAL=IBEXTVAL Q

 . I IBTYPE=1,IBEXTVAL'="" Q

 . I IBTYPE=2,IBBUFVAL="" Q

 . I IBTYPE=4,'$D(^TMP($J,"IB BUFFER SELECTED",IB1)) Q

. ;

 . S IBCHNG(IBXFILE,IBEXTDA,IB2)=IBBUFVAL

. ;

 . ; -- for ACCEPAPI^IBCNICB do not delete the .01 field. This prevents a Data Dictionary Deletion Write message

 . Q:IB2=".01"!(IB2="4.03")!(IB2="6")!(IB2="7.01")

. ;

 . S IBCHNGN(IBXFILE,IBEXTDA,IB2)=""

STUFF(IBSET,IBEXTDA,IBRESULT) ; update fields in insurance files that

 N IBX,IBFLDS,IBLBLS,IBADDS,EXTFILE,IBEXTFLD,IBEXTVAL,IBFDA,IBFDAX,IBERR

 D FIELDS(IBSET_"A",.IBFLDS,.IBLBLS,.IBADDS)

 S IBX=$P($T(@(IBSET_"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 IBFDA(EXTFILE,IBEXTDA,IBEXTFLD)=IBEXTVAL

 . S IBFDAX(EXTFILE,IBEXTDA,IBEXTFLD)=""

 ; -- update fields with nulls (external values)

 D FILE^DIE("E","IBFDAX","IBERR") I $D(IBERR)>0 D EHANDLE(IBSET,.IBERR,.IBRESULT)

 ; -- update fields with data (external values)

 D FILE^DIE("E","IBFDA","IBERR") I $D(IBERR)>0 D EHANDLE(IBSET,.IBERR,.IBRESULT)

POLOTH(IBBUFDA,IBEXTDA,IBRESULT) ; other special cases that can not be transferred using the generic code above, usually because of dependencies

 N IB0,IBFDA,IBFDAX,IBERR

 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 IBFDA(2.312,IBEXTDA,1.03)=$E($P(IB0,U,10),1,12),IBFDAX(2.312,IBEXTDA,1.03)=""

 . S IBFDA(2.312,IBEXTDA,1.04)=$P(IB0,U,11),IBFDAX(2.312,IBEXTDA,1.04)=""

 ; -- update fields with nulls (internally)

 I $D(IBFDAX)>9 D FILE^DIE("","IBFDAX","IBERR") I $D(IBERR)>0 D EHANDLE("POL",.IBERR,.IBRESULT)

 ; -- update fields data (internally)

 I $D(IBFDA)>9 D FILE^DIE("","IBFDA","IBERR") I $D(IBERR)>0 D EHANDLE("POL",.IBERR,.IBRESULT)

FIELDS(IBSET,IBFLDS,IBLBLS,IBADDS) ; return array of corresponding fields: IBFLDS(Buffer #)=Ins #

 N IBI,IBLN,IBB,IBE,IBG

 F IBI=1:1 S IBLN=$P($T(@(IBSET)+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 IBSET["FLD" S IBLBLS(IBB)=$P(IBLN,U,3) I +IBG S IBADDS(IBB)=IBE

EHANDLE(IBSET,FMERR,IBRESULT) ;

 ;Fileman Error Processing tracking added for ACCEPAPI^IBCNICB API.

 ; INPUT:

 ;   IBSET - File where fileman error occurred

 ;      Value = "INS" --> File 36    --> IBRESULT(1)

 ;      Value = "GRP" --> File 355.3 --> IBRESULT(2)

 ;      Value = "POL" --> File 2.312 --> IBRESULT(3)

 ;   FMERR  - Array that is returned by FM with error messages

 ; OUTPUT:

 ;   IBRESULT - Passed array to return FM error message if there are

 ;            errors when filing the data buffer data

 I $G(IBSET)']""!($D(FMERR)'>0) Q

 N SUB1,RNUM,ERRNUM,LINENUM

 ; -- numeric 1st subscript of IBRESULT array based on file being updated. File 36 = 1, 355.3 = 2, 2.312 = 3

 S SUB1=$S(IBSET="INS":1,IBSET="GRP":2,IBSET="POL":3,1:"") Q:SUB1']""

 S RNUM=$O(IBRESULT(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 IBRESULT(SUB1,"ERR",RNUM)=FMERR("DIERR",ERRNUM,"TEXT",LINENUM)

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)

DPTDR ; -- insurance type subfile(#2.312) ^ insurance verificaiton processor(#355.33) fields ^ insurance type subfile(#2.312) fields

 ;;2.312^90.03;60.05;60.14;60.15;60.16;91.01;.03;.09;.02;60.1;60.11;60.12;62.01;.111;.112;.114;.115;.116;.1173;.131^7.02;6;4.03;4.05;4.06;7.01;3.01;3.05;3.12;4.01;4.02;.2;5.01;3.06;3.07;3.08;3.09;3.1;3.13;3.11

DPTFLD ; -- insurance verification processor(#355.33) field ^ insurance type subfile(#2.312)

 ;;90.03^7.02^Subscriber Id^          ; Subscriber Id

 ;;60.05^6^Whose Insurance^           ; Whose Insurance

 ;;60.14^4.03^Relationship^             ; Pt. Relationship to Insured

 ;;60.15^4.05^Rx Relationship^        ; Pharmacy Relationship Code

 ;;60.16^4.06^Rx Person Code^         ; Pharmacy Person Code

 ;;91.01^7.01^Subscriber Name^        ; Name of Insured

 ;;.03^3.01^Subscriber's DOB^         ; Insured's DOB

 ;;.09^3.05^Subscriber's SSN^         ; Insured's SSN

 ;;.02^3.12^Subscriber's Sex^         ; Insured's Sex

 ;;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

 ;;62.01^5.01^Patient Id^             ; Patient Id

 ;;.111^3.06^Subscr Str Ln 1^         ; Subscriber Address Line 1

 ;;.112^3.07^Subscr Str Ln 2^         ; Subscriber Address Line 2

 ;;.114^3.08^Subscr City^             ; Subscriber City

 ;;.115^3.09^Subscr State^            ; Subscriber State

 ;;.116^3.1^Subscr Zip^               ; Subscriber Zip Code

 ;;.1173^3.13^Subscr Country^         ; Subscriber Country Code

 ;;.131^3.11^Subscr Phone^            ; Subscriber Phone Number

DGPRDR ; -- insurance type subfile(#2.312) ^ insurance verificaiton processor(#355.33) fields ^ insurance type subfile(#2.312) fields

 ;;2.312^90.03;60.05;60.14;60.15;60.16;.01;.03;.09;.02;60.1;60.11;60.12;62.01;1.2;1.3;1.5;1.6;1.7;1.99;1.8^7.02;6;4.03;4.05;4.06;7.01;3.01;3.05;3.12;4.01;4.02;.2;5.01;3.06;3.07;3.08;3.09;3.1;3.13;3.11

DGPRFLD ; -- insurance verification processor(#355.33) field ^ insurance type subfile(#2.312)

 ;;90.03^7.02^Subscriber Id^          ; Subscriber Id

 ;;60.05^6^Whose Insurance^           ; Whose Insurance

 ;;60.14^4.03^Relationship^             ; Pt. Relationship to Insured

 ;;60.15^4.05^Rx Relationship^        ; Pharmacy Relationship Code

 ;;60.16^4.06^Rx Person Code^         ; Pharmacy Person Code

 ;;.01^7.01^Subscriber Name^          ; Name of Insured

 ;;.03^3.01^Subscriber's DOB^         ; Insured's DOB

 ;;.09^3.05^Subscriber's SSN^         ; Insured's SSN

 ;;.02^3.12^Subscriber's Sex^         ; Insured's Sex

 ;;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

 ;;62.01^5.01^Patient Id^             ; Patient Id

 ;;1.2^3.06^Subscr Str Ln 1^          ; Subscriber Address Line 1

 ;;1.3^3.07^Subscr Str Ln 2^          ; Subscriber Address Line 2

 ;;1.5^3.08^Subscr City^              ; Subscriber City

 ;;1.6^3.09^Subscr State^             ; Subscriber State

 ;;1.7^3.1^Subscr Zip^                ; Subscriber Zip Code

 ;;1.99^3.13^Subscr Country^          ; Subscriber Country Code

 ;;1.8^3.11^Subscr Phone^             ; Subscriber Phone Number

NDR ; -- insurance type subfile(#2.312) ^ insurance verificaiton processor(#355.33) fields ^ insurance type subfile(#2.312) fields

 ;;2.312^90.03;60.05;60.14;60.15;60.16;.01;.03;.09;.02;60.1;60.11;60.12;62.01;1.2;1.3;1.5;1.6;1.7;1.99;1.8^7.02;6;4.03;4.05;4.06;7.01;3.01;3.05;3.12;4.01;4.02;.2;5.01;3.06;3.07;3.08;3.09;3.1;3.13;3.11

NFLD ; -- insurance verification processor(#355.33) field ^ insurance type subfile(#2.312)

 ;;90.03^7.02^Subscriber Id^          ; Subscriber Id

 ;;60.05^6^Whose Insurance^           ; Whose Insurance

 ;;60.14^4.03^Relationship^             ; Pt. Relationship to Insured

 ;;60.15^4.05^Rx Relationship^        ; Pharmacy Relationship Code

 ;;60.16^4.06^Rx Person Code^         ; Pharmacy Person Code

 ;;.01^7.01^Subscriber Name^          ; Name of Insured

 ;;.03^3.01^Subscriber's DOB^         ; Insured's DOB

 ;;.09^3.05^Subscriber's SSN^         ; Insured's SSN

 ;;.02^3.12^Subscriber's Sex^         ; Insured's Sex

 ;;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

 ;;62.01^5.01^Patient Id^             ; Patient Id

 ;;1.2^3.06^Subscr Str Ln 1^          ; Subscriber Address Line 1

 ;;1.3^3.07^Subscr Str Ln 2^          ; Subscriber Address Line 2

 ;;1.5^3.08^Subscr City^              ; Subscriber City

 ;;1.6^3.09^Subscr State^             ; Subscriber State

 ;;1.7^3.1^Subscr Zip^                ; Subscriber Zip Code

 ;;1.99^3.13^Subscr Country^          ; Subscriber Country Code

 ;;1.8^3.11^Subscr Phone^             ; Subscriber Phone Number

POLDR ;

 ;;2.312

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBCD6   13759     printed  Apr 23, 2025@18:28:26                                                                                                                                                                                                   Page 2

IBCNBCD6  ;ALB/AWC - MCCF FY14 Subscriber Display Screens ;25 Feb 2015

 +1       ;;2.0;INTEGRATED BILLING;**528**;21-MAR-94;Build 163

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ;Input Parameters:

 +5       ;  See routine IBCNBCD1

 +6       ;

SUB(IBBUFDA,IBEXTDA,IBRIEN,IBSEL,IBTYPE,IBRESULT,DFN,IBFNAM,IBVAL,IBHOLD,IBXHOLD) ; called from routine SUB^IBCMBMI

 +1       ; Move patient data(file #2) <or> income person data(408.13) into existing Patient Policy (file 2.312)

 +2       ;

 +3        NEW IBX,IBSET,IBXFILE,BUFARR,EXTARR,IBFLDS,IBLBLS,IBADDS,IBDRB,IBDRX,IBERR,IBCHNG,IBCHNGN,IBBFDA

 +4        SET IBBFDA=IBBUFDA_","

 +5        SET IBEXTDA=$GET(IBEXTDA)_","_DFN_","

 +6       ;

 +7        IF IBSEL=18

               Begin DoDot:1

 +8                IF IBFNAM="DPT"

                       SET IBSET="DPT"

                       DO SELF(IBSET,IBBFDA,IBRIEN,IBEXTDA,IBTYPE,.BUFARR,.EXTARR,.IBCHNG,.IBCHNGN,.IBFLDS,.IBLBLS,.IBADDS,.IBRESULT,.IBHOLD,.IBXHOLD)

               End DoDot:1

 +9       ;

 +10      ; -- if user selected "spouse" use income person file(#408.13) to get specific data/fields

 +11       IF IBSEL=1

               Begin DoDot:1

 +12               IF IBFNAM="DGPR"

                       SET IBSET="DGPR"

                       DO SPOUSE(IBSET,IBBFDA,IBRIEN,IBEXTDA,IBTYPE,.BUFARR,.EXTARR,.IBCHNG,.IBCHNGN,.IBFLDS,.IBLBLS,.IBADDS,.IBRESULT,.IBHOLD,.IBXHOLD)

                       QUIT

 +13               IF IBFNAM']""

                       SET IBSET="N"

                       DO NSPOUSE(IBSET,IBBFDA,IBRIEN,IBEXTDA,IBTYPE,.BUFARR,.EXTARR,.IBCHNG,.IBCHNGN,.IBFLDS,.IBLBLS,.IBADDS,.IBRESULT,.IBHOLD,.IBXHOLD)

               End DoDot:1

 +14      ;

 +15      ; -- update policy fields with nulls

 +16       IF $DATA(IBCHNGN)>9

               DO FILE^DIE("E","IBCHNGN","IBERR")

               IF $DATA(IBERR)

                   WRITE !,"Error... SUB-IBCNBCD6  Could not file fields with nulls"

                   KILL DIR

                   DO PAUSE^VALM1

                   QUIT

 +17      ; -- update policy fields with data

 +18       IF $DATA(IBCHNG)>9

               DO FILE^DIE("E","IBCHNG","IBERR")

               IF $DATA(IBERR)>0

                   WRITE !,"Error... SUB-IBCNBCD6  Could not file fields with data"

                   KILL DIR

                   DO PAUSE^VALM1

                   QUIT

 +19      ;

 +20      ; -- update policy fields with user information

 +21       DO STUFF("POL",IBEXTDA,.IBRESULT)

 +22      ; -- update policy with verified-by information

 +23       DO POLOTH(IBBFDA,IBEXTDA,.IBRESULT)

 +24       QUIT

 +25      ;

SELF(IBSET,IBBUFDA,IBRIEN,IBEXTDA,IBTYPE,BUFARR,EXTARR,IBCHNG,IBCHNGN,IBFLDS,IBLBLS,IBADDS,IBRESULT,IBHOLD,IBXHOLD) ; get data for "self" relationship

 +1        NEW IBX,IB1,IB2,IBXARY,IBFARY,IBDRB,IBDRX,IBBUFVAL,IBEXTFLD,IBEXTVAL,IBXFILE

 +2       ;

 +3       ; -- get corresponding fields to populate data

 +4        DO FIELDS(IBSET_"FLD",.IBFLDS,.IBLBLS,.IBADDS)

 +5        SET IBX=$PIECE($TEXT(@(IBSET_"DR")+1),";;",2)

           SET IBXFILE=+$PIECE(IBX,U,1)

           SET IBDRB=$PIECE(IBX,U,2)

           SET IBDRX=$PIECE(IBX,U,3)

 +6       ;

 +7        IF +$GET(IBTYPE)

               FOR IBX=1:1:$LENGTH(IBDRB,";")

                   Begin DoDot:1

 +8       ;

 +9                    SET IB1=$PIECE(IBDRB,";",IBX)

                       SET IB2=$PIECE(IBDRX,";",IBX)

 +10      ;

 +11                   SET IBBUFVAL=$GET(@IBHOLD@(2,IB1))

                       SET IBEXTVAL=$GET(@IBXHOLD@(2,IB2))

 +12      ;

 +13                   IF IBBUFVAL=IBEXTVAL

                           QUIT

 +14                   IF IBTYPE=1

                           IF IBEXTVAL'=""

                               QUIT

 +15                   IF IBTYPE=2

                           IF IBBUFVAL=""

                               QUIT

 +16                   IF IBTYPE=4

                           IF '$DATA(^TMP($JOB,"IB BUFFER SELECTED",IB1))

                               QUIT

 +17      ;

 +18      ;

 +19                   SET IBCHNG(IBXFILE,IBEXTDA,IB2)=IBBUFVAL

 +20      ;

 +21      ; -- for ACCEPAPI^IBCNICB do not delete the .01 field. This prevents a Data Dictionary Deletion Write message

 +22                   if IB2=".01"!(IB2="4.03")!(IB2="6")!(IB2="7.01")

                           QUIT

 +23      ;

 +24                   SET IBCHNGN(IBXFILE,IBEXTDA,IB2)=""

                   End DoDot:1

 +25       QUIT

 +26      ;

SPOUSE(IBSET,IBBUFDA,IBRIEN,IBEXTDA,IBTYPE,BUFARR,EXTARR,IBCHNG,IBCHNGN,IBFLDS,IBLBLS,IBADDS,IBRESULT,IBHOLD,IBXHOLD) ; get data for "spouse" relationship

 +1        NEW IBX,IBXARY,IBFARY,IBDRB,IBDRX,IBBUFVAL,IBEXTFLD,IBEXTVAL,IBXFILE

 +2       ;

 +3       ; -- get corresponding fields to populate data

 +4        DO FIELDS(IBSET_"FLD",.IBFLDS,.IBLBLS,.IBADDS)

 +5        SET IBX=$PIECE($TEXT(@(IBSET_"DR")+1),";;",2)

           SET IBXFILE=+$PIECE(IBX,U,1)

           SET IBDRB=$PIECE(IBX,U,2)

           SET IBDRX=$PIECE(IBX,U,3)

 +6       ;

 +7        IF +$GET(IBTYPE)

               FOR IBX=1:1:$LENGTH(IBDRB,";")

                   Begin DoDot:1

 +8       ;

 +9                    SET IB1=$PIECE(IBDRB,";",IBX)

                       SET IB2=$PIECE(IBDRX,";",IBX)

 +10      ;

 +11                   SET IBBUFVAL=$GET(@IBHOLD@(2,IB1))

                       SET IBEXTVAL=$GET(@IBXHOLD@(2,IB2))

 +12      ;

 +13                   IF IBBUFVAL=IBEXTVAL

                           QUIT

 +14                   IF IBTYPE=1

                           IF IBEXTVAL'=""

                               QUIT

 +15                   IF IBTYPE=2

                           IF IBBUFVAL=""

                               QUIT

 +16                   IF IBTYPE=4

                           IF '$DATA(^TMP($JOB,"IB BUFFER SELECTED",IB1))

                               QUIT

 +17      ;

 +18                   SET IBCHNG(IBXFILE,IBEXTDA,IB2)=IBBUFVAL

 +19      ;

 +20      ; -- for ACCEPAPI^IBCNICB do not delete the .01 field. This prevents a Data Dictionary Deletion Write message

 +21                   if IB2=".01"!(IB2="4.03")!(IB2="6")!(IB2="7.01")

                           QUIT

 +22      ;

 +23                   SET IBCHNGN(IBXFILE,IBEXTDA,IB2)=""

                   End DoDot:1

 +24       QUIT

 +25      ;

NSPOUSE(IBSET,IBBFDA,IBRIEN,IBEXTDA,IBTYPE,BUFARR,EXTARR,IBCHNG,IBCHNGN,IBFLDS,IBLBLS,IBADDS,IBRESULT,IBHOLD,IBXHOLD) ; no spuse data

 +1        NEW IBX,IBXARY,IBFARY,IBDRB,IBDRX,IBBUFVAL,IBEXTFLD,IBEXTVAL,IBXFILE

 +2       ;

 +3       ; -- left side of screen get data from income person(#408.13) fields

 +4        DO FIELDS(IBSET_"FLD",.IBFLDS,.IBLBLS,.IBADDS)

 +5        SET IBX=$PIECE($TEXT(@(IBSET_"DR")+1),";;",2)

           SET IBXFILE=+$PIECE(IBX,U,1)

           SET IBDRB=$PIECE(IBX,U,2)

           SET IBDRX=$PIECE(IBX,U,3)

 +6       ;

 +7        IF +$GET(IBTYPE)

               FOR IBX=1:1:$LENGTH(IBDRB,";")

                   Begin DoDot:1

 +8       ;

 +9                    SET IB1=$PIECE(IBDRB,";",IBX)

                       SET IB2=$PIECE(IBDRX,";",IBX)

 +10      ;

 +11                   SET IBBUFVAL=$GET(@IBHOLD@(2,IB1))

                       SET IBEXTVAL=$GET(@IBXHOLD@(2,IB2))

 +12      ;

 +13                   IF IBBUFVAL=IBEXTVAL

                           QUIT

 +14                   IF IBTYPE=1

                           IF IBEXTVAL'=""

                               QUIT

 +15                   IF IBTYPE=2

                           IF IBBUFVAL=""

                               QUIT

 +16                   IF IBTYPE=4

                           IF '$DATA(^TMP($JOB,"IB BUFFER SELECTED",IB1))

                               QUIT

 +17      ;

 +18                   SET IBCHNG(IBXFILE,IBEXTDA,IB2)=IBBUFVAL

 +19      ;

 +20      ; -- for ACCEPAPI^IBCNICB do not delete the .01 field. This prevents a Data Dictionary Deletion Write message

 +21                   if IB2=".01"!(IB2="4.03")!(IB2="6")!(IB2="7.01")

                           QUIT

 +22      ;

 +23                   SET IBCHNGN(IBXFILE,IBEXTDA,IB2)=""

                   End DoDot:1

 +24       QUIT

 +25      ;

STUFF(IBSET,IBEXTDA,IBRESULT) ; update fields in insurance files that

 +1        NEW IBX,IBFLDS,IBLBLS,IBADDS,EXTFILE,IBEXTFLD,IBEXTVAL,IBFDA,IBFDAX,IBERR

 +2       ;

 +3        DO FIELDS(IBSET_"A",.IBFLDS,.IBLBLS,.IBADDS)

 +4        SET IBX=$PIECE($TEXT(@(IBSET_"DR")+1),";;",2)

           SET EXTFILE=+$PIECE(IBX,U,1)

 +5       ;

 +6        SET IBEXTFLD=0

FOR

               SET IBEXTFLD=$ORDER(IBFLDS(IBEXTFLD))

               if 'IBEXTFLD

                   QUIT

               Begin DoDot:1

 +7                SET IBEXTVAL=IBFLDS(IBEXTFLD)

                   IF IBEXTVAL="DUZ"

                       SET IBEXTVAL="`"_DUZ

 +8                SET IBFDA(EXTFILE,IBEXTDA,IBEXTFLD)=IBEXTVAL

 +9                SET IBFDAX(EXTFILE,IBEXTDA,IBEXTFLD)=""

               End DoDot:1

 +10      ;

 +11      ; -- update fields with nulls (external values)

 +12       DO FILE^DIE("E","IBFDAX","IBERR")

           IF $DATA(IBERR)>0

               DO EHANDLE(IBSET,.IBERR,.IBRESULT)

 +13      ; -- update fields with data (external values)

 +14       DO FILE^DIE("E","IBFDA","IBERR")

           IF $DATA(IBERR)>0

               DO EHANDLE(IBSET,.IBERR,.IBRESULT)

 +15       QUIT

 +16      ;

POLOTH(IBBUFDA,IBEXTDA,IBRESULT) ; other special cases that can not be transferred using the generic code above, usually because of dependencies

 +1        NEW IB0,IBFDA,IBFDAX,IBERR

 +2        SET IB0=$GET(^IBA(355.33,+IBBUFDA,0))

 +3       ;

 +4       ;  -- if buffer entry was verified before the accept step, then add the correct verifier info to the policy

 +5        IF +$PIECE(IB0,U,10)

               Begin DoDot:1

 +6                SET IBFDA(2.312,IBEXTDA,1.03)=$EXTRACT($PIECE(IB0,U,10),1,12)

                   SET IBFDAX(2.312,IBEXTDA,1.03)=""

 +7                SET IBFDA(2.312,IBEXTDA,1.04)=$PIECE(IB0,U,11)

                   SET IBFDAX(2.312,IBEXTDA,1.04)=""

               End DoDot:1

 +8       ;

 +9       ; -- update fields with nulls (internally)

 +10       IF $DATA(IBFDAX)>9

               DO FILE^DIE("","IBFDAX","IBERR")

               IF $DATA(IBERR)>0

                   DO EHANDLE("POL",.IBERR,.IBRESULT)

 +11      ; -- update fields data (internally)

 +12       IF $DATA(IBFDA)>9

               DO FILE^DIE("","IBFDA","IBERR")

               IF $DATA(IBERR)>0

                   DO EHANDLE("POL",.IBERR,.IBRESULT)

 +13       QUIT

 +14      ;

FIELDS(IBSET,IBFLDS,IBLBLS,IBADDS) ; return array of corresponding fields: IBFLDS(Buffer #)=Ins #

 +1        NEW IBI,IBLN,IBB,IBE,IBG

 +2       ;

 +3        FOR IBI=1:1

               SET IBLN=$PIECE($TEXT(@(IBSET)+IBI),";;",2)

               if IBLN=""

                   QUIT

               IF $EXTRACT(IBLN,1)'=" "

                   Begin DoDot:1

 +4                    SET IBB=$PIECE(IBLN,U,1)

                       SET IBE=$PIECE(IBLN,U,2)

                       SET IBG=$PIECE(IBLN,U,4)

 +5                    IF IBB'=""

                           IF IBE'=""

                               Begin DoDot:2

 +6                                SET IBFLDS(IBB)=IBE

 +7                                IF IBSET["FLD"

                                       SET IBLBLS(IBB)=$PIECE(IBLN,U,3)

                                       IF +IBG

                                           SET IBADDS(IBB)=IBE

                               End DoDot:2

                   End DoDot:1

 +8        QUIT

 +9       ;

EHANDLE(IBSET,FMERR,IBRESULT) ;

 +1       ;Fileman Error Processing tracking added for ACCEPAPI^IBCNICB API.

 +2       ; INPUT:

 +3       ;   IBSET - File where fileman error occurred

 +4       ;      Value = "INS" --> File 36    --> IBRESULT(1)

 +5       ;      Value = "GRP" --> File 355.3 --> IBRESULT(2)

 +6       ;      Value = "POL" --> File 2.312 --> IBRESULT(3)

 +7       ;   FMERR  - Array that is returned by FM with error messages

 +8       ; OUTPUT:

 +9       ;   IBRESULT - Passed array to return FM error message if there are

 +10      ;            errors when filing the data buffer data

 +11      ;

 +12       IF $GET(IBSET)']""!($DATA(FMERR)'>0)

               QUIT

 +13       NEW SUB1,RNUM,ERRNUM,LINENUM

 +14      ;

 +15      ; -- numeric 1st subscript of IBRESULT array based on file being updated. File 36 = 1, 355.3 = 2, 2.312 = 3

 +16       SET SUB1=$SELECT(IBSET="INS":1,IBSET="GRP":2,IBSET="POL":3,1:"")

           if SUB1']""

               QUIT

 +17      ;

 +18       SET RNUM=$ORDER(IBRESULT(SUB1,"ERR",9999999999),-1)

           SET ERRNUM=0

 +19       FOR

               SET ERRNUM=$ORDER(FMERR("DIERR",ERRNUM))

               if +ERRNUM'>0

                   QUIT

               Begin DoDot:1

 +20               SET LINENUM=0

 +21               FOR

                       SET LINENUM=$ORDER(FMERR("DIERR",ERRNUM,"TEXT",LINENUM))

                       if +LINENUM'>0

                           QUIT

                       Begin DoDot:2

 +22                       SET RNUM=RNUM+1

 +23                       SET IBRESULT(SUB1,"ERR",RNUM)=FMERR("DIERR",ERRNUM,"TEXT",LINENUM)

                       End DoDot:2

               End DoDot:1

 +24       QUIT

 +25      ;

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       ;

 +6       ; INPUT/OUTPUT:

 +7       ;   FMERR  - Array that is returned by FM with error messages

 +8       ;

 +9        if $DATA(FMERR)'>0

               QUIT

 +10       NEW ERRNUM

 +11       SET ERRNUM=0

 +12       FOR

               SET ERRNUM=$ORDER(FMERR("DIERR",ERRNUM))

               if +ERRNUM'>0

                   QUIT

               Begin DoDot:1

 +13               IF FMERR("DIERR",ERRNUM)=712

                       KILL FMERR("DIERR",ERRNUM)

               End DoDot:1

 +14       QUIT

 +15      ;

DPTDR     ; -- insurance type subfile(#2.312) ^ insurance verificaiton processor(#355.33) fields ^ insurance type subfile(#2.312) fields

 +1       ;;2.312^90.03;60.05;60.14;60.15;60.16;91.01;.03;.09;.02;60.1;60.11;60.12;62.01;.111;.112;.114;.115;.116;.1173;.131^7.02;6;4.03;4.05;4.06;7.01;3.01;3.05;3.12;4.01;4.02;.2;5.01;3.06;3.07;3.08;3.09;3.1;3.13;3.11

 +2       ;

DPTFLD    ; -- insurance verification processor(#355.33) field ^ insurance type subfile(#2.312)

 +1       ;;90.03^7.02^Subscriber Id^          ; Subscriber Id

 +2       ;;60.05^6^Whose Insurance^           ; Whose Insurance

 +3       ;;60.14^4.03^Relationship^             ; Pt. Relationship to Insured

 +4       ;;60.15^4.05^Rx Relationship^        ; Pharmacy Relationship Code

 +5       ;;60.16^4.06^Rx Person Code^         ; Pharmacy Person Code

 +6       ;;91.01^7.01^Subscriber Name^        ; Name of Insured

 +7       ;;.03^3.01^Subscriber's DOB^         ; Insured's DOB

 +8       ;;.09^3.05^Subscriber's SSN^         ; Insured's SSN

 +9       ;;.02^3.12^Subscriber's Sex^         ; Insured's Sex

 +10      ;;60.1^4.01^Primary Provider^        ; Primary Care Provider

 +11      ;;60.11^4.02^Provider Phone^         ; Primary Care Provider Phone

 +12      ;;60.12^.2^Coor of Benefits^         ; Coordination of Benefits

 +13      ;;62.01^5.01^Patient Id^             ; Patient Id

 +14      ;;.111^3.06^Subscr Str Ln 1^         ; Subscriber Address Line 1

 +15      ;;.112^3.07^Subscr Str Ln 2^         ; Subscriber Address Line 2

 +16      ;;.114^3.08^Subscr City^             ; Subscriber City

 +17      ;;.115^3.09^Subscr State^            ; Subscriber State

 +18      ;;.116^3.1^Subscr Zip^               ; Subscriber Zip Code

 +19      ;;.1173^3.13^Subscr Country^         ; Subscriber Country Code

 +20      ;;.131^3.11^Subscr Phone^            ; Subscriber Phone Number

 +21      ;

DGPRDR    ; -- insurance type subfile(#2.312) ^ insurance verificaiton processor(#355.33) fields ^ insurance type subfile(#2.312) fields

 +1       ;;2.312^90.03;60.05;60.14;60.15;60.16;.01;.03;.09;.02;60.1;60.11;60.12;62.01;1.2;1.3;1.5;1.6;1.7;1.99;1.8^7.02;6;4.03;4.05;4.06;7.01;3.01;3.05;3.12;4.01;4.02;.2;5.01;3.06;3.07;3.08;3.09;3.1;3.13;3.11

 +2       ;

DGPRFLD   ; -- insurance verification processor(#355.33) field ^ insurance type subfile(#2.312)

 +1       ;;90.03^7.02^Subscriber Id^          ; Subscriber Id

 +2       ;;60.05^6^Whose Insurance^           ; Whose Insurance

 +3       ;;60.14^4.03^Relationship^             ; Pt. Relationship to Insured

 +4       ;;60.15^4.05^Rx Relationship^        ; Pharmacy Relationship Code

 +5       ;;60.16^4.06^Rx Person Code^         ; Pharmacy Person Code

 +6       ;;.01^7.01^Subscriber Name^          ; Name of Insured

 +7       ;;.03^3.01^Subscriber's DOB^         ; Insured's DOB

 +8       ;;.09^3.05^Subscriber's SSN^         ; Insured's SSN

 +9       ;;.02^3.12^Subscriber's Sex^         ; Insured's Sex

 +10      ;;60.1^4.01^Primary Provider^        ; Primary Care Provider

 +11      ;;60.11^4.02^Provider Phone^         ; Primary Care Provider Phone

 +12      ;;60.12^.2^Coor of Benefits^         ; Coordination of Benefits

 +13      ;;62.01^5.01^Patient Id^             ; Patient Id

 +14      ;;1.2^3.06^Subscr Str Ln 1^          ; Subscriber Address Line 1

 +15      ;;1.3^3.07^Subscr Str Ln 2^          ; Subscriber Address Line 2

 +16      ;;1.5^3.08^Subscr City^              ; Subscriber City

 +17      ;;1.6^3.09^Subscr State^             ; Subscriber State

 +18      ;;1.7^3.1^Subscr Zip^                ; Subscriber Zip Code

 +19      ;;1.99^3.13^Subscr Country^          ; Subscriber Country Code

 +20      ;;1.8^3.11^Subscr Phone^             ; Subscriber Phone Number

 +21      ;

NDR       ; -- insurance type subfile(#2.312) ^ insurance verificaiton processor(#355.33) fields ^ insurance type subfile(#2.312) fields

 +1       ;;2.312^90.03;60.05;60.14;60.15;60.16;.01;.03;.09;.02;60.1;60.11;60.12;62.01;1.2;1.3;1.5;1.6;1.7;1.99;1.8^7.02;6;4.03;4.05;4.06;7.01;3.01;3.05;3.12;4.01;4.02;.2;5.01;3.06;3.07;3.08;3.09;3.1;3.13;3.11

 +2       ;

NFLD      ; -- insurance verification processor(#355.33) field ^ insurance type subfile(#2.312)

 +1       ;;90.03^7.02^Subscriber Id^          ; Subscriber Id

 +2       ;;60.05^6^Whose Insurance^           ; Whose Insurance

 +3       ;;60.14^4.03^Relationship^             ; Pt. Relationship to Insured

 +4       ;;60.15^4.05^Rx Relationship^        ; Pharmacy Relationship Code

 +5       ;;60.16^4.06^Rx Person Code^         ; Pharmacy Person Code

 +6       ;;.01^7.01^Subscriber Name^          ; Name of Insured

 +7       ;;.03^3.01^Subscriber's DOB^         ; Insured's DOB

 +8       ;;.09^3.05^Subscriber's SSN^         ; Insured's SSN

 +9       ;;.02^3.12^Subscriber's Sex^         ; Insured's Sex

 +10      ;;60.1^4.01^Primary Provider^        ; Primary Care Provider

 +11      ;;60.11^4.02^Provider Phone^         ; Primary Care Provider Phone

 +12      ;;60.12^.2^Coor of Benefits^         ; Coordination of Benefits

 +13      ;;62.01^5.01^Patient Id^             ; Patient Id

 +14      ;;1.2^3.06^Subscr Str Ln 1^          ; Subscriber Address Line 1

 +15      ;;1.3^3.07^Subscr Str Ln 2^          ; Subscriber Address Line 2

 +16      ;;1.5^3.08^Subscr City^              ; Subscriber City

 +17      ;;1.6^3.09^Subscr State^             ; Subscriber State

 +18      ;;1.7^3.1^Subscr Zip^                ; Subscriber Zip Code

 +19      ;;1.99^3.13^Subscr Country^          ; Subscriber Country Code

 +20      ;;1.8^3.11^Subscr Phone^             ; Subscriber Phone Number

 +21      ;

POLDR     ;

 +1       ;;2.312

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       ;

IBCNBCD6.m