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))
Q
;
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))
Q
;
; 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
Q
;
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)=""
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
