Routine: IBCNSC0

IBCNSC0 ;ALB/NLR - INSURANCE COMPANY EDIT - ; 12-MAR-1993

 ;;2.0;INTEGRATED BILLING;**371,547,592,702**;21-MAR-94;Build 53

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

CLAIMS1 ; display Inpatient Claims information

 N OFFSET,START,IBCNS12,IBADD

 ;WCJ;IB*2.0*547

 ;S START=27,OFFSET=2

 S START=28+(2*$G(IBACMAX)),OFFSET=2

CLMS1AD ; KDM US2487 IB*2.0*592  call in tag from IBCNSI

 D SET^IBCNSP(START,OFFSET+20," Inpatient Claims Office Information ",IORVON,IORVOFF)

 ;WCJ;IB*2.0*547;Call New API

 ;S IBCNS12=$$ADDRESS(IBCNS,.12,5)

 S IBCNS12=$$ADD2(IBCNS,.12,5)

 D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS12,"^",7),0)),"^",1))

 D SET^IBCNSP(START+2,OFFSET,"       Street: "_$P(IBCNS12,"^",1))

 D SET^IBCNSP(START+3,OFFSET,"     Street 2: "_$P(IBCNS12,"^",2))

 N OFFSET S OFFSET=45

 D SET^IBCNSP(START+1,OFFSET,"     Street 3: "_$P(IBCNS12,"^",3)) S IBADD=1

 D SET^IBCNSP(START+1+IBADD,OFFSET,"   City/State: "_$E($P(IBCNS12,"^",4),1,15)_$S($P(IBCNS12,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS12,"^",5),0)),"^",2)_" "_$E($P(IBCNS12,"^",6),1,5))

 D SET^IBCNSP(START+2+IBADD,OFFSET,"        Phone: "_$P(IBCNS12,"^",8))

 D SET^IBCNSP(START+3+IBADD,OFFSET,"          Fax: "_$P(IBCNS12,"^",9))

R1Q Q

CLAIMS2 ; display Outpatient Claims information

 N OFFSET,START,IBCNS16,IBADD

 ;WCJ;IB*2.0*547

 ;S START=34,OFFSET=2

 S START=35+(2*$G(IBACMAX)),OFFSET=2

CLMS2AD ; KDM US2487 IB*2.0*592  call in tag from IBCNSI

 D SET^IBCNSP(START,OFFSET+20," Outpatient Claims Office Information ",IORVON,IORVOFF)

 ;WCJ;IB*2.0*547;Call New API

 ;S IBCNS16=$$ADDRESS(IBCNS,.16,6)

 S IBCNS16=$$ADD2(IBCNS,.16,6)

 D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS16,"^",7),0)),"^",1))

 D SET^IBCNSP(START+2,OFFSET,"       Street: "_$P(IBCNS16,"^",1))

 D SET^IBCNSP(START+3,OFFSET,"     Street 2: "_$P(IBCNS16,"^",2))

 N OFFSET S OFFSET=45

 D SET^IBCNSP(START+1,OFFSET,"     Street 3: "_$P(IBCNS16,"^",3)) S IBADD=1

 D SET^IBCNSP(START+1+IBADD,OFFSET,"   City/State: "_$E($P(IBCNS16,"^",4),1,15)_$S($P(IBCNS16,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS16,"^",5),0)),"^",2)_" "_$E($P(IBCNS16,"^",6),1,5))

 D SET^IBCNSP(START+2+IBADD,OFFSET,"        Phone: "_$P(IBCNS16,"^",8))

 D SET^IBCNSP(START+3+IBADD,OFFSET,"          Fax: "_$P(IBCNS16,"^",9))

 ; Only adding comments on patch 547.  Changes are on the ADD2 tag below.

 ; This tag is called from the Output formatter.

 ; It returns a "complete" address

 ; It judges an address complete if it has a state (don't ask why, I am just adding the comments)

 ; If the address it wants is not complete, it returns the main address.

 ; These addresses go out on claims and claims (X12 837) don't like partial addresses.

ADDRESS(INS,NODE,PH) ; -- generic find address

 N IBX,INSSAVE,IBPH,IBFX,IBCNT,IBA

 S IBX="" ;S IBPH="",IBFX="",IBA=""

REDO ; gather insurance carrier's main address information

 S IBX=$G(^DIC(36,+INS,.11)),IBPH=$P($G(^DIC(36,+INS,.13)),"^",1),IBFX=$P(IBX,"^",9)

 ;S IBCNT=$G(IBCNT)+1

 ; -- if process the same co. more than once you are in an infinite loop

 ;I $D(IBCNT(IBCNS)) G ADDREQ

 ;S IBCNT(IBCNS)=""

 ; -- gather address information from specific office (Claims, Appeals, Inquiry, Dental)

 ;JWS;IB*2.0*592;Changed below for DENTAL insurance mailing address

 ;IA #5292

 I $P($G(^DIC(36,+INS,+NODE)),"^",5) D

 . S IBX=$G(^DIC(36,+INS,+NODE))

 . I +NODE=.19 S IBPH=$P(IBX,"^",PH)

 . E  S IBPH=$P($G(^DIC(36,+INS,.13)),"^",PH)

 . S IBFX=$P($G(IBX),"^",9)

 I $P($G(^DIC(36,+INS,+NODE)),"^",7) S INSSAVE=INS,INS=$P($G(^DIC(36,+INS,+NODE)),"^",7) I INSSAVE'=INS G REDO

ADDRESQ ; concatenate company name, address, phone and fax

 S $P(IBA,"^",1,6)=$P($G(IBX),"^",1,6)

 S $P(IBA,"^",7)=INS

 S $P(IBA,"^",8)=IBPH

 S $P(IBA,"^",9)=IBFX

ADDREQ Q IBA

 ; WCJ;IB*2.0*547;

 ; This is a new tag which is just called from the insurance company editor screens.

 ; The billers/insurance verifiers want to see what data is actually in the insurance company file.

 ; They don't care if it's complete.  Heck, a phone number may be enough.

 ; This will just return what is in the file for the ins company that handles that type of claims.

 ; Input: INS - IREN to file 36

 ;        NODE - Node in File 36 (corresponds to Claims, Appeals, Inquiry...)

 ;        PH - Location of Phone number in node .13

ADD2(INS,NODE,PH) ;

 N IBX,INSSAVE,IBFX,IBPH,IBA

 F  S IBX=$G(^DIC(36,+INS,+NODE)) Q:'$P(IBX,U,7)  S INSSAVE=INS,INS=$P(IBX,U,7) Q:INSSAVE=INS

 ; concatenate company name, address, phone and fax

 S IBPH=$P($G(^DIC(36,+INS,.13)),U,PH),IBFX=$P(IBX,U,9)

 ;JWS;IB*2.0*592;Dental mailing address

 ;IA# 5292

 I +NODE=.19 S IBPH=$P($G(^DIC(36,+INS,.19)),U,11)

 S $P(IBA,U,1,6)=$P(IBX,U,1,6),$P(IBA,U,7)=INS,$P(IBA,U,8)=IBPH,$P(IBA,U,9)=IBFX

 Q IBA

 ;IB*2.0*702/ckb - the following code is called by the Input Template, IBEDIT

 ;  INS CO1. It will prompt for 3 Filing Time Frame (FTF) fields that are stored

 ;  in File #36. The fields are .12 FILING TIME FRAME, .18 STANDARD FTF and

 ;  .19 STANDARD FTF VALUE

FTF(IBIEN,IBEXIT) ; Edit Filing Time Frame fields

 ; Input:  IBIEN - IEN of the entry being checked

 ;        IBEXIT - 0 default value from input template

 ; Returns: 1 - if user entered '^' to exit for any of the FTF fields

 N DELETE,DIC,DIR,DIRUT,IB12,IB12PRE,IB18,IB18PE,IB18PRE,IB19,IB19PRE

 N IBFLG12,IBFLG18,IBFLG19,IBGARR,IBGCT,IBIENS,IBSKIP,U,X,Y

 S IBIENS=IBIEN_","

 ; Capture the value of the FTF fields before any edits

 S IB18PE=$$GET1^DIQ(36,IBIENS,.18),IB18PRE=$$GET1^DIQ(36,IBIENS,.18,"I")

 S IB19PRE=$$GET1^DIQ(36,IBIENS,.19)

 S IB12PRE=$$GET1^DIQ(36,IBIENS,.12)

 S (IBFLG18,IBFLG19,IBFLG12,IBSKIP)=0

 S (IB18,IB19,IB12)=""

 ;Prompt for field .18

 D PFLD18

 I X="^" S IBEXIT=1 G CHECK

 ; If field .18 was deleted or has no value (IBSKIP=1),

 ; DO NOT prompt for field .19, go to prompt for field .12

 I IBSKIP=1 G P12

 ;Prompt for field .19

 D PFLD19

 I X="^" S IBEXIT=1 G CHECK

P12 ;Prompt for field .12

 D PFLD12

 I X="^" S IBEXIT=1 G CHECK

CHECK ;

 ; If NONE of the 3 fields were updated, quit

 I 'IBFLG12&'IBFLG18&'IBFLG19 G QUIT

 ; Add updated FTF fields to Insurance Co in File #36

 D UPDINS

 ; Get count of all Active group plans, if none were found quit

 D GETGRP

 I IBGCT=0 G QUIT  ; in no active grps don't continue with 'Are you sure' prompts

 ;Ask user if they want to change the FTF fields for all ACTIVE group plans

 ; default is NO

W !

 K DIR,DIRUT,X,Y

 S DIR(0)="Y"

 S DIR("A",1)="Do you want to change the Filing Time Frame for all"

 S DIR("A")="ACTIVE group plans ("_IBGCT_" Groups)"

 S DIR("B")="NO"

 S DIR("?",1)="Answering YES will change the Filing Time Frame for all ACTIVE"

 S DIR("?",2)="group plans for this insurance company. This does not affect"

 S DIR("?",3)="individual plans. Inaccurate Filing Time Frames can negatively"

 S DIR("?",4)="impact billing. Answering NO will not affect the current values"

 S DIR("?")="of the Filing Time Frame for any group plans."

 D ^DIR

 I X="^" S IBEXIT=1 G QUIT

 I $D(DIRUT)!(Y=0) G QUIT

 ;If YES above, display values of FTF fields and prompt "Are you sure....?"

 ; default is NO

 W !!,"The Filing Time Frame for all ACTIVE group plans will be changed to:"

 W !,"      STANDARD FILING TIME FRAME: ",$S(IB18="@":"<deleted>",1:$$GET1^DIQ(36,IBIENS,.18))

 W !,"STANDARD FILING TIME FRAME VALUE: ",$S(IB19="@":"<deleted>",1:$$GET1^DIQ(36,IBIENS,.19))

 W !,"               FILING TIME FRAME: ",$S(IB12="@":"<deleted>",1:$$GET1^DIQ(36,IBIENS,.12))

W !

 K DIR,DIRUT,X,Y

 S DIR(0)="Y"

 S DIR("A",1)="Are you sure you would like to change the Filing Time"

 S DIR("A")="Frame for all ACTIVE group plans"

 S DIR("B")="NO"

 S DIR("?",1)="Answering YES will change the Filing Time Frame for all ACTIVE"

 S DIR("?",2)="group plans for this insurance company. This does not affect"

 S DIR("?",3)="individual plans. Inaccurate Filing Time Frames can negatively"

 S DIR("?",4)="impact billing. Answering NO will not affect the current values"

 S DIR("?")="of the Filing Time Frame for any group plans."

 D ^DIR

 I X="^" S IBEXIT=1 G QUIT

 I $D(DIRUT)!(Y=0) G QUIT

 ;Update all ACTIVE group plans

 D UPDGRP

W !

QUIT ;

 Q IBEXIT

UPDINS ; Update Insurance Co FTF fields  (added with IB*702)

 N INSERR,INSUPD

 S INSUPD(36,IBIENS,.18)=IB18  ; STANDARD FTF

 S INSUPD(36,IBIENS,.19)=IB19  ; STANDARD FTF VALUE

 S INSUPD(36,IBIENS,.12)=IB12  ; FILING TIME FRAME

 D FILE^DIE("I","INSUPD","INSERR")  ; currently not evaluating INSERR

GETGRP ; Get count of all Active group plans  (added with IB*702)

 N IBAGP,IBGIEN,IBGIENS,IBINACT

 S IBGCT=0

 S IBGIEN=0 F  S IBGIEN=$O(^IBA(355.3,"B",IBIEN,IBGIEN)) Q:('IBGIEN)!(IBGIEN="")  D

 . S IBGIENS=IBGIEN_","

 . S IBINACT=$$GET1^DIQ(355.3,IBGIENS,.11,"I") ;INACTIVE

 . I IBINACT Q                                 ; The Plan is Inactive

 . S IBAGP=$$GET1^DIQ(355.3,IBGIENS,.02,"I")    ;IS THIS A GROUP POLICY?

 . I IBAGP=0 Q               ; Not a Group Plan (skips individual plans)

 . S IBGCT=IBGCT+1

 . S IBGARR(IBGIEN)=""

UPDGRP ; Update all Active group plans with ALL Insurance Co FTF fields (added with IB*702)

 N GRPERR,GRPUPD,IBG

 S IBG=0 F  S IBG=$O(IBGARR(IBG)) Q:'IBG  D

 . S GRPUPD(355.3,IBG_",",.16)=IB18  ;PLAN STANDARD FTF

 . S GRPUPD(355.3,IBG_",",.17)=IB19  ;PLAN STANDARD FTF VALUE

 . S GRPUPD(355.3,IBG_",",.13)=IB12  ;PLAN FILING TIME FRAME

 . D FILE^DIE("I","GRPUPD","GRPERR")  ; currently not evaluating GRPERR

PFLD18 ; Prompt for field .18 STANDARD FTF  (added with IB*702)

 K DIR,X,Y

 S DELETE=""

 S DIR(0)="PO^355.13:AEMQ"

 S DIR("A")="STANDARD FILING TIME FRAME"

 S DIR("B")=IB18PE

 ;The user should not be presented with the 'replace'..'with' when the filing time

 ; frame "external" value stored is greater than 19

 I $L(IB18PE)>19 D

 . S DIR("A",1)="STANDARD FILING TIME FRAME: "_IB18PE

 . S DIR("A")="       "

 . S DIR("B")=""

 D ^DIR I X="^" Q

 S IB18=X I +Y>0 S IB18=+Y

 ;If the user didn't change the default value (they hit enter), no change was

 ; made. If IB18=7 or IB18=8 DO NOT prompt for field .19 (IBSKIP)

 I IB18="",IB18PRE'="" S:(IB18PRE=7)!(IB18PRE=8) IBSKIP=1 Q

 I IB18=IB18PRE S:(IB18=7)!(IB18=8) IBSKIP=1 Q

 D EVFLD18

EVFLD18 ;Evaluate field .18. Determine if field .18 should be updated (IBFLG18=1) and

 ; if the user should be prompted to enter STANDARD FTF VALUE field .19

 ;If user deletes field .18, field .19 will also be deleted.

 ; DO NOT prompt for .19 (IBSKIP=1). Both fields have been updated (IBFLG18,IBFLG19)

 I IB18="@" D  I 'DELETE W " <NOTHING DELETED>" G PFLD18

 . S DELETE=$$DELETE()

 . I DELETE D

 . . S (IBSKIP,IBFLG18)=1

 ;If the user DID NOT enter 7-END OF FOLLOWING YEAR or 8-NO FILING TIME FRAME, update field .18

 ; (IBFLG18=1) and prompt user for field .19

 I IB18'=7,IB18'=8 S IBFLG18=1

 ;If the user entered 7-END OF FOLLOWING YEAR and 8-NO FILING TIME FRAME, update field .18 (IBFLG18).

 ; DO NOT prompt user for field .19 (IBSKIP=1). If there is data in field .19 delete it and

 ; update field .19 (IBFLG19)

 I (IB18=7)!(IB18=8) S IBSKIP=1,IBFLG18=1

 ;If field .18 is changed/deleted, delete field .19

 I IBFLG18 I IB19PRE'="" S IB19PRE="",IB19="@",IBFLG19=1

PFLD19 ; Prompt for field .19 STANDARD FTF VALUE  (added with IB*702)

 K DIR,DIRUT,X,Y

 S DELETE=""

 S DIR(0)="NAO^0:999999:1"

 S DIR("A")="STANDARD FILING TIME FRAME VALUE: "

 ;Only display the default if there was an existing value for field .19

 I IB19PRE'="" S DIR("B")=IB19PRE

 S DIR("?")=" Type a Number between 0 and 999999, 1 Decimal Digit"

 D ^DIR I X="^" Q

 S IB19=X

 ;If user hit enter to accept the default, no change was made, quit

 I IB19=IB19PRE Q

 ;If user entered '@', ask "Are you sure?", if 'NO' Prompt user again

 I IB19="@" D  I 'DELETE W " <NOTHING DELETED>" G PFLD19

 . S DELETE=$$DELETE()

 . I DELETE S IBFLG19=1

 ;User changed the value, set IBFLG19

 I IB19PRE'=IB19 S IBFLG19=1

PFLD12 ; Prompt for field .12 FILING TIME FRAME  (added with IB*702)

 K DIR,DIRUT,X,Y

 S DELETE=""

 S DIR(0)="FO^3:30"

 S DIR("A")="FILING TIME FRAME"

 ;Only display the default if there was an existing value for field .12

 I IB12PRE'="" S DIR("B")=IB12PRE

 S DIR("?",1)=" Enter maximum amount of time from date of service that the insurance"

 S DIR("?",2)=" company allows for submitting claims. Answer must be 3-30 characters in"

 S DIR("?")=" length."

 D ^DIR I X="^" Q

 S IB12=X

 ;If user hit enter to accept the default, no change was made, quit

 I IB12=IB12PRE Q

 ;If user entered '@', ask "Are you sure?", if 'NO' Prompt user again

 I IB12="@" D  I 'DELETE W " <NOTHING DELETED>" G PFLD12

 . S DELETE=$$DELETE()

 . I DELETE S IBFLG12=1

 ;User changed the value, set IBFLG12

 I IB12PRE'=IB12 S IBFLG12=1

DELETE() ; Confirm Deletion  (added with IB*702)

 ; Returns:  1 - YES

 ;           0 - NO or user entered "^"

 K DIR,DIRUT,X,Y

 S DIR(0)="Y"

 S DIR("A")="  SURE YOU WANT TO DELETE"

 S DIR("B")="Yes"

 D ^DIR

 I $D(DIRUT) Q 0

Q Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSC0   13242     printed  Mar 13, 2025@21:21:52                                                                                                                                                                                                    Page 2

IBCNSC0   ;ALB/NLR - INSURANCE COMPANY EDIT - ; 12-MAR-1993

 +1       ;;2.0;INTEGRATED BILLING;**371,547,592,702**;21-MAR-94;Build 53

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

 +3       ;

CLAIMS1   ; display Inpatient Claims information

 +1        NEW OFFSET,START,IBCNS12,IBADD

 +2       ;WCJ;IB*2.0*547

 +3       ;S START=27,OFFSET=2

 +4        SET START=28+(2*$GET(IBACMAX))

           SET OFFSET=2

CLMS1AD   ; KDM US2487 IB*2.0*592  call in tag from IBCNSI

 +1        DO SET^IBCNSP(START,OFFSET+20," Inpatient Claims Office Information ",IORVON,IORVOFF)

 +2       ;

 +3       ;WCJ;IB*2.0*547;Call New API

 +4       ;S IBCNS12=$$ADDRESS(IBCNS,.12,5)

 +5        SET IBCNS12=$$ADD2(IBCNS,.12,5)

 +6       ;

 +7        DO SET^IBCNSP(START+1,OFFSET," Company Name: "_$PIECE($GET(^DIC(36,+$PIECE(IBCNS12,"^",7),0)),"^",1))

 +8        DO SET^IBCNSP(START+2,OFFSET,"       Street: "_$PIECE(IBCNS12,"^",1))

 +9        DO SET^IBCNSP(START+3,OFFSET,"     Street 2: "_$PIECE(IBCNS12,"^",2))

 +10       NEW OFFSET

           SET OFFSET=45

 +11       DO SET^IBCNSP(START+1,OFFSET,"     Street 3: "_$PIECE(IBCNS12,"^",3))

           SET IBADD=1

 +12       DO SET^IBCNSP(START+1+IBADD,OFFSET,"   City/State: "_$EXTRACT($PIECE(IBCNS12,"^",4),1,15)_$SELECT($PIECE(IBCNS12,"^",4)="":"",1:", ")_$PIECE($GET(^DIC(5,+$PIECE(IBCNS12,"^",5),0)),"^",2)_" "_$EXTRACT($PIECE(IBCNS12,"^",6),1,5))

 +13       DO SET^IBCNSP(START+2+IBADD,OFFSET,"        Phone: "_$PIECE(IBCNS12,"^",8))

 +14       DO SET^IBCNSP(START+3+IBADD,OFFSET,"          Fax: "_$PIECE(IBCNS12,"^",9))

 +15       QUIT

 +16      ;

R1Q        QUIT

CLAIMS2   ; display Outpatient Claims information

 +1       ;

 +2        NEW OFFSET,START,IBCNS16,IBADD

 +3       ;WCJ;IB*2.0*547

 +4       ;S START=34,OFFSET=2

 +5        SET START=35+(2*$GET(IBACMAX))

           SET OFFSET=2

CLMS2AD   ; KDM US2487 IB*2.0*592  call in tag from IBCNSI

 +1        DO SET^IBCNSP(START,OFFSET+20," Outpatient Claims Office Information ",IORVON,IORVOFF)

 +2       ;

 +3       ;WCJ;IB*2.0*547;Call New API

 +4       ;S IBCNS16=$$ADDRESS(IBCNS,.16,6)

 +5        SET IBCNS16=$$ADD2(IBCNS,.16,6)

 +6       ;

 +7        DO SET^IBCNSP(START+1,OFFSET," Company Name: "_$PIECE($GET(^DIC(36,+$PIECE(IBCNS16,"^",7),0)),"^",1))

 +8        DO SET^IBCNSP(START+2,OFFSET,"       Street: "_$PIECE(IBCNS16,"^",1))

 +9        DO SET^IBCNSP(START+3,OFFSET,"     Street 2: "_$PIECE(IBCNS16,"^",2))

 +10       NEW OFFSET

           SET OFFSET=45

 +11       DO SET^IBCNSP(START+1,OFFSET,"     Street 3: "_$PIECE(IBCNS16,"^",3))

           SET IBADD=1

 +12       DO SET^IBCNSP(START+1+IBADD,OFFSET,"   City/State: "_$EXTRACT($PIECE(IBCNS16,"^",4),1,15)_$SELECT($PIECE(IBCNS16,"^",4)="":"",1:", ")_$PIECE($GET(^DIC(5,+$PIECE(IBCNS16,"^",5),0)),"^",2)_" "_$EXTRACT($PIECE(IBCNS16,"^",6),1,5))

 +13       DO SET^IBCNSP(START+2+IBADD,OFFSET,"        Phone: "_$PIECE(IBCNS16,"^",8))

 +14       DO SET^IBCNSP(START+3+IBADD,OFFSET,"          Fax: "_$PIECE(IBCNS16,"^",9))

 +15       QUIT

 +16      ;

 +17      ; Only adding comments on patch 547.  Changes are on the ADD2 tag below.

 +18      ; This tag is called from the Output formatter.

 +19      ; It returns a "complete" address

 +20      ; It judges an address complete if it has a state (don't ask why, I am just adding the comments)

 +21      ; If the address it wants is not complete, it returns the main address.

 +22      ; These addresses go out on claims and claims (X12 837) don't like partial addresses.

ADDRESS(INS,NODE,PH) ; -- generic find address

 +1       ;

 +2        NEW IBX,INSSAVE,IBPH,IBFX,IBCNT,IBA

 +3       ;S IBPH="",IBFX="",IBA=""

           SET IBX=""

 +4       ;

REDO      ; gather insurance carrier's main address information

 +1        SET IBX=$GET(^DIC(36,+INS,.11))

           SET IBPH=$PIECE($GET(^DIC(36,+INS,.13)),"^",1)

           SET IBFX=$PIECE(IBX,"^",9)

 +2       ;S IBCNT=$G(IBCNT)+1

 +3       ;

 +4       ; -- if process the same co. more than once you are in an infinite loop

 +5       ;I $D(IBCNT(IBCNS)) G ADDREQ

 +6       ;S IBCNT(IBCNS)=""

 +7       ;

 +8       ; -- gather address information from specific office (Claims, Appeals, Inquiry, Dental)

 +9       ;JWS;IB*2.0*592;Changed below for DENTAL insurance mailing address

 +10      ;IA #5292

 +11       IF $PIECE($GET(^DIC(36,+INS,+NODE)),"^",5)

               Begin DoDot:1

 +12               SET IBX=$GET(^DIC(36,+INS,+NODE))

 +13               IF +NODE=.19

                       SET IBPH=$PIECE(IBX,"^",PH)

 +14              IF '$TEST

                       SET IBPH=$PIECE($GET(^DIC(36,+INS,.13)),"^",PH)

 +15               SET IBFX=$PIECE($GET(IBX),"^",9)

               End DoDot:1

 +16       IF $PIECE($GET(^DIC(36,+INS,+NODE)),"^",7)

               SET INSSAVE=INS

               SET INS=$PIECE($GET(^DIC(36,+INS,+NODE)),"^",7)

               IF INSSAVE'=INS

                   GOTO REDO

 +17      ;

ADDRESQ   ; concatenate company name, address, phone and fax

 +1        SET $PIECE(IBA,"^",1,6)=$PIECE($GET(IBX),"^",1,6)

 +2        SET $PIECE(IBA,"^",7)=INS

 +3        SET $PIECE(IBA,"^",8)=IBPH

 +4        SET $PIECE(IBA,"^",9)=IBFX

ADDREQ     QUIT IBA

 +1       ;

 +2       ; WCJ;IB*2.0*547;

 +3       ; This is a new tag which is just called from the insurance company editor screens.

 +4       ; The billers/insurance verifiers want to see what data is actually in the insurance company file.

 +5       ; They don't care if it's complete.  Heck, a phone number may be enough.

 +6       ; This will just return what is in the file for the ins company that handles that type of claims.

 +7       ; Input: INS - IREN to file 36

 +8       ;        NODE - Node in File 36 (corresponds to Claims, Appeals, Inquiry...)

 +9       ;        PH - Location of Phone number in node .13

ADD2(INS,NODE,PH) ;

 +1        NEW IBX,INSSAVE,IBFX,IBPH,IBA

 +2        FOR

               SET IBX=$GET(^DIC(36,+INS,+NODE))

               if '$PIECE(IBX,U,7)

                   QUIT

               SET INSSAVE=INS

               SET INS=$PIECE(IBX,U,7)

               if INSSAVE=INS

                   QUIT

 +3       ; concatenate company name, address, phone and fax

 +4        SET IBPH=$PIECE($GET(^DIC(36,+INS,.13)),U,PH)

           SET IBFX=$PIECE(IBX,U,9)

 +5       ;JWS;IB*2.0*592;Dental mailing address

 +6       ;IA# 5292

 +7        IF +NODE=.19

               SET IBPH=$PIECE($GET(^DIC(36,+INS,.19)),U,11)

 +8        SET $PIECE(IBA,U,1,6)=$PIECE(IBX,U,1,6)

           SET $PIECE(IBA,U,7)=INS

           SET $PIECE(IBA,U,8)=IBPH

           SET $PIECE(IBA,U,9)=IBFX

 +9        QUIT IBA

 +10      ;

 +11      ;IB*2.0*702/ckb - the following code is called by the Input Template, IBEDIT

 +12      ;  INS CO1. It will prompt for 3 Filing Time Frame (FTF) fields that are stored

 +13      ;  in File #36. The fields are .12 FILING TIME FRAME, .18 STANDARD FTF and

 +14      ;  .19 STANDARD FTF VALUE

 +15      ;

FTF(IBIEN,IBEXIT) ; Edit Filing Time Frame fields

 +1       ; Input:  IBIEN - IEN of the entry being checked

 +2       ;        IBEXIT - 0 default value from input template

 +3       ; Returns: 1 - if user entered '^' to exit for any of the FTF fields

 +4        NEW DELETE,DIC,DIR,DIRUT,IB12,IB12PRE,IB18,IB18PE,IB18PRE,IB19,IB19PRE

 +5        NEW IBFLG12,IBFLG18,IBFLG19,IBGARR,IBGCT,IBIENS,IBSKIP,U,X,Y

 +6       ;

 +7        SET IBIENS=IBIEN_","

 +8       ;

 +9       ; Capture the value of the FTF fields before any edits

 +10       SET IB18PE=$$GET1^DIQ(36,IBIENS,.18)

           SET IB18PRE=$$GET1^DIQ(36,IBIENS,.18,"I")

 +11       SET IB19PRE=$$GET1^DIQ(36,IBIENS,.19)

 +12       SET IB12PRE=$$GET1^DIQ(36,IBIENS,.12)

 +13      ;

 +14       SET (IBFLG18,IBFLG19,IBFLG12,IBSKIP)=0

 +15       SET (IB18,IB19,IB12)=""

 +16      ;

 +17      ;Prompt for field .18

 +18       DO PFLD18

 +19       IF X="^"

               SET IBEXIT=1

               GOTO CHECK

 +20      ; If field .18 was deleted or has no value (IBSKIP=1),

 +21      ; DO NOT prompt for field .19, go to prompt for field .12

 +22       IF IBSKIP=1

               GOTO P12

 +23      ;

 +24      ;Prompt for field .19

 +25       DO PFLD19

 +26       IF X="^"

               SET IBEXIT=1

               GOTO CHECK

 +27      ;

P12       ;Prompt for field .12

 +1        DO PFLD12

 +2        IF X="^"

               SET IBEXIT=1

               GOTO CHECK

 +3       ;

CHECK     ;

 +1       ; If NONE of the 3 fields were updated, quit

 +2        IF 'IBFLG12&'IBFLG18&'IBFLG19

               GOTO QUIT

 +3       ;

 +4       ; Add updated FTF fields to Insurance Co in File #36

 +5        DO UPDINS

 +6       ; Get count of all Active group plans, if none were found quit

 +7        DO GETGRP

 +8       ; in no active grps don't continue with 'Are you sure' prompts

           IF IBGCT=0

               GOTO QUIT

 +9       ;

 +10      ;Ask user if they want to change the FTF fields for all ACTIVE group plans

 +11      ; default is NO

 +12       WRITE !

 +13       KILL DIR,DIRUT,X,Y

 +14       SET DIR(0)="Y"

 +15       SET DIR("A",1)="Do you want to change the Filing Time Frame for all"

 +16       SET DIR("A")="ACTIVE group plans ("_IBGCT_" Groups)"

 +17       SET DIR("B")="NO"

 +18       SET DIR("?",1)="Answering YES will change the Filing Time Frame for all ACTIVE"

 +19       SET DIR("?",2)="group plans for this insurance company. This does not affect"

 +20       SET DIR("?",3)="individual plans. Inaccurate Filing Time Frames can negatively"

 +21       SET DIR("?",4)="impact billing. Answering NO will not affect the current values"

 +22       SET DIR("?")="of the Filing Time Frame for any group plans."

 +23       DO ^DIR

 +24       IF X="^"

               SET IBEXIT=1

               GOTO QUIT

 +25       IF $DATA(DIRUT)!(Y=0)

               GOTO QUIT

 +26      ;

 +27      ;If YES above, display values of FTF fields and prompt "Are you sure....?"

 +28      ; default is NO

 +29       WRITE !!,"The Filing Time Frame for all ACTIVE group plans will be changed to:"

 +30       WRITE !,"      STANDARD FILING TIME FRAME: ",$SELECT(IB18="@":"<deleted>",1:$$GET1^DIQ(36,IBIENS,.18))

 +31       WRITE !,"STANDARD FILING TIME FRAME VALUE: ",$SELECT(IB19="@":"<deleted>",1:$$GET1^DIQ(36,IBIENS,.19))

 +32       WRITE !,"               FILING TIME FRAME: ",$SELECT(IB12="@":"<deleted>",1:$$GET1^DIQ(36,IBIENS,.12))

 +33       WRITE !

 +34       KILL DIR,DIRUT,X,Y

 +35       SET DIR(0)="Y"

 +36       SET DIR("A",1)="Are you sure you would like to change the Filing Time"

 +37       SET DIR("A")="Frame for all ACTIVE group plans"

 +38       SET DIR("B")="NO"

 +39       SET DIR("?",1)="Answering YES will change the Filing Time Frame for all ACTIVE"

 +40       SET DIR("?",2)="group plans for this insurance company. This does not affect"

 +41       SET DIR("?",3)="individual plans. Inaccurate Filing Time Frames can negatively"

 +42       SET DIR("?",4)="impact billing. Answering NO will not affect the current values"

 +43       SET DIR("?")="of the Filing Time Frame for any group plans."

 +44       DO ^DIR

 +45       IF X="^"

               SET IBEXIT=1

               GOTO QUIT

 +46       IF $DATA(DIRUT)!(Y=0)

               GOTO QUIT

 +47      ;

 +48      ;Update all ACTIVE group plans

 +49       DO UPDGRP

 +50       WRITE !

 +51      ;

QUIT      ;

 +1        QUIT IBEXIT

 +2       ;

 +3       ;

UPDINS    ; Update Insurance Co FTF fields  (added with IB*702)

 +1        NEW INSERR,INSUPD

 +2       ; STANDARD FTF

           SET INSUPD(36,IBIENS,.18)=IB18

 +3       ; STANDARD FTF VALUE

           SET INSUPD(36,IBIENS,.19)=IB19

 +4       ; FILING TIME FRAME

           SET INSUPD(36,IBIENS,.12)=IB12

 +5       ; currently not evaluating INSERR

           DO FILE^DIE("I","INSUPD","INSERR")

 +6        QUIT

 +7       ;

GETGRP    ; Get count of all Active group plans  (added with IB*702)

 +1        NEW IBAGP,IBGIEN,IBGIENS,IBINACT

 +2        SET IBGCT=0

 +3        SET IBGIEN=0

FOR

               SET IBGIEN=$ORDER(^IBA(355.3,"B",IBIEN,IBGIEN))

               if ('IBGIEN)!(IBGIEN="")

                   QUIT

               Begin DoDot:1

 +4                SET IBGIENS=IBGIEN_","

 +5       ;INACTIVE

                   SET IBINACT=$$GET1^DIQ(355.3,IBGIENS,.11,"I")

 +6       ; The Plan is Inactive

                   IF IBINACT

                       QUIT

 +7       ;IS THIS A GROUP POLICY?

                   SET IBAGP=$$GET1^DIQ(355.3,IBGIENS,.02,"I")

 +8       ; Not a Group Plan (skips individual plans)

                   IF IBAGP=0

                       QUIT

 +9                SET IBGCT=IBGCT+1

 +10               SET IBGARR(IBGIEN)=""

               End DoDot:1

 +11       QUIT

 +12      ;

UPDGRP    ; Update all Active group plans with ALL Insurance Co FTF fields (added with IB*702)

 +1        NEW GRPERR,GRPUPD,IBG

 +2        SET IBG=0

FOR

               SET IBG=$ORDER(IBGARR(IBG))

               if 'IBG

                   QUIT

               Begin DoDot:1

 +3       ;PLAN STANDARD FTF

                   SET GRPUPD(355.3,IBG_",",.16)=IB18

 +4       ;PLAN STANDARD FTF VALUE

                   SET GRPUPD(355.3,IBG_",",.17)=IB19

 +5       ;PLAN FILING TIME FRAME

                   SET GRPUPD(355.3,IBG_",",.13)=IB12

 +6       ; currently not evaluating GRPERR

                   DO FILE^DIE("I","GRPUPD","GRPERR")

               End DoDot:1

 +7        QUIT

 +8       ;

PFLD18    ; Prompt for field .18 STANDARD FTF  (added with IB*702)

 +1        KILL DIR,X,Y

 +2        SET DELETE=""

 +3        SET DIR(0)="PO^355.13:AEMQ"

 +4        SET DIR("A")="STANDARD FILING TIME FRAME"

 +5        SET DIR("B")=IB18PE

 +6       ;The user should not be presented with the 'replace'..'with' when the filing time

 +7       ; frame "external" value stored is greater than 19

 +8        IF $LENGTH(IB18PE)>19

               Begin DoDot:1

 +9                SET DIR("A",1)="STANDARD FILING TIME FRAME: "_IB18PE

 +10               SET DIR("A")="       "

 +11               SET DIR("B")=""

               End DoDot:1

 +12       DO ^DIR

           IF X="^"

               QUIT

 +13       SET IB18=X

           IF +Y>0

               SET IB18=+Y

 +14      ;

 +15      ;If the user didn't change the default value (they hit enter), no change was

 +16      ; made. If IB18=7 or IB18=8 DO NOT prompt for field .19 (IBSKIP)

 +17       IF IB18=""

               IF IB18PRE'=""

                   if (IB18PRE=7)!(IB18PRE=8)

                       SET IBSKIP=1

                   QUIT

 +18       IF IB18=IB18PRE

               if (IB18=7)!(IB18=8)

                   SET IBSKIP=1

               QUIT

 +19       DO EVFLD18

 +20       QUIT

 +21      ;

EVFLD18   ;Evaluate field .18. Determine if field .18 should be updated (IBFLG18=1) and

 +1       ; if the user should be prompted to enter STANDARD FTF VALUE field .19

 +2       ;

 +3       ;If user deletes field .18, field .19 will also be deleted.

 +4       ; DO NOT prompt for .19 (IBSKIP=1). Both fields have been updated (IBFLG18,IBFLG19)

 +5        IF IB18="@"

               Begin DoDot:1

 +6                SET DELETE=$$DELETE()

 +7                IF DELETE

                       Begin DoDot:2

 +8                        SET (IBSKIP,IBFLG18)=1

                       End DoDot:2

               End DoDot:1

               IF 'DELETE

                   WRITE " <NOTHING DELETED>"

                   GOTO PFLD18

 +9       ;If the user DID NOT enter 7-END OF FOLLOWING YEAR or 8-NO FILING TIME FRAME, update field .18

 +10      ; (IBFLG18=1) and prompt user for field .19

 +11       IF IB18'=7

               IF IB18'=8

                   SET IBFLG18=1

 +12      ;If the user entered 7-END OF FOLLOWING YEAR and 8-NO FILING TIME FRAME, update field .18 (IBFLG18).

 +13      ; DO NOT prompt user for field .19 (IBSKIP=1). If there is data in field .19 delete it and

 +14      ; update field .19 (IBFLG19)

 +15       IF (IB18=7)!(IB18=8)

               SET IBSKIP=1

               SET IBFLG18=1

 +16      ;If field .18 is changed/deleted, delete field .19

 +17       IF IBFLG18

               IF IB19PRE'=""

                   SET IB19PRE=""

                   SET IB19="@"

                   SET IBFLG19=1

 +18       QUIT

 +19      ;

PFLD19    ; Prompt for field .19 STANDARD FTF VALUE  (added with IB*702)

 +1        KILL DIR,DIRUT,X,Y

 +2        SET DELETE=""

 +3        SET DIR(0)="NAO^0:999999:1"

 +4        SET DIR("A")="STANDARD FILING TIME FRAME VALUE: "

 +5       ;Only display the default if there was an existing value for field .19

 +6        IF IB19PRE'=""

               SET DIR("B")=IB19PRE

 +7        SET DIR("?")=" Type a Number between 0 and 999999, 1 Decimal Digit"

 +8        DO ^DIR

           IF X="^"

               QUIT

 +9        SET IB19=X

 +10      ;If user hit enter to accept the default, no change was made, quit

 +11       IF IB19=IB19PRE

               QUIT

 +12      ;If user entered '@', ask "Are you sure?", if 'NO' Prompt user again

 +13       IF IB19="@"

               Begin DoDot:1

 +14               SET DELETE=$$DELETE()

 +15               IF DELETE

                       SET IBFLG19=1

               End DoDot:1

               IF 'DELETE

                   WRITE " <NOTHING DELETED>"

                   GOTO PFLD19

 +16      ;User changed the value, set IBFLG19

 +17       IF IB19PRE'=IB19

               SET IBFLG19=1

 +18       QUIT

 +19      ;

PFLD12    ; Prompt for field .12 FILING TIME FRAME  (added with IB*702)

 +1        KILL DIR,DIRUT,X,Y

 +2        SET DELETE=""

 +3        SET DIR(0)="FO^3:30"

 +4        SET DIR("A")="FILING TIME FRAME"

 +5       ;Only display the default if there was an existing value for field .12

 +6        IF IB12PRE'=""

               SET DIR("B")=IB12PRE

 +7        SET DIR("?",1)=" Enter maximum amount of time from date of service that the insurance"

 +8        SET DIR("?",2)=" company allows for submitting claims. Answer must be 3-30 characters in"

 +9        SET DIR("?")=" length."

 +10       DO ^DIR

           IF X="^"

               QUIT

 +11       SET IB12=X

 +12      ;If user hit enter to accept the default, no change was made, quit

 +13       IF IB12=IB12PRE

               QUIT

 +14      ;If user entered '@', ask "Are you sure?", if 'NO' Prompt user again

 +15       IF IB12="@"

               Begin DoDot:1

 +16               SET DELETE=$$DELETE()

 +17               IF DELETE

                       SET IBFLG12=1

               End DoDot:1

               IF 'DELETE

                   WRITE " <NOTHING DELETED>"

                   GOTO PFLD12

 +18      ;User changed the value, set IBFLG12

 +19       IF IB12PRE'=IB12

               SET IBFLG12=1

 +20       QUIT

 +21      ;

DELETE()  ; Confirm Deletion  (added with IB*702)

 +1       ; Returns:  1 - YES

 +2       ;           0 - NO or user entered "^"

 +3        KILL DIR,DIRUT,X,Y

 +4        SET DIR(0)="Y"

 +5        SET DIR("A")="  SURE YOU WANT TO DELETE"

 +6        SET DIR("B")="Yes"

 +7        DO ^DIR

 +8        IF $DATA(DIRUT)

               QUIT 0

 +9        QUIT Y

IBCNSC0.m