IBCNSP01 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993
;;2.0;INTEGRATED BILLING;**43,52,85,251,371,377,416,452,497,595**;21-MAR-94;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
;
% D SUBSC,RIDER
Q
;
SUBSC ; -- subscriber region ;IB*2*497 move subscriber lines around
N OFFSET,START,RX,DATARRY,X1,SAV
S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2,RX=0 ;IB*2*497
D SET^IBCNSP(START,OFFSET," Subscriber Information ",IORVON,IORVOFF)
S Y=$P(IBCDFND,U,6),C=$P(^DD(2.312,6,0),U,2) D Y^DIQ
D SET^IBCNSP(START+1,OFFSET,$$RJ^XLFSTR("Whose Insurance: ",19)_Y)
D SPLIT(OFFSET,$$RJ^XLFSTR("Subscriber Name: ",19),$P(IBCDFND7,U),.DATARRY)
S (SAV,X1)=0 F S X1=$O(DATARRY(X1)) Q:'X1 D
. S START=$O(^TMP("IBCNSVP",$J,""),-1)+1
. D SET^IBCNSP(START,OFFSET,DATARRY(X1))
S Y=$P(IBCDFND4,U,3),C=$P(^DD(2.312,4.03,0),U,2) D Y^DIQ
S START=$O(^TMP("IBCNSVP",$J,""),-1)+1
D SET^IBCNSP(START,OFFSET,$$RJ^XLFSTR("Relationship: ",19)_Y)
K DATARRY D SPLIT(OFFSET,$$RJ^XLFSTR("Primary ID: ",19),$P(IBCDFND7,U,2),.DATARRY)
S X1=0 F S X1=$O(DATARRY(X1)) Q:'X1 D
. S START=$O(^TMP("IBCNSVP",$J,""),-1)+1
. D SET^IBCNSP(START,OFFSET,DATARRY(X1))
S Y=$P(IBCDFND,U,20),C=$P(^DD(2.312,.2,0),U,2) D Y^DIQ
S START=$O(^TMP("IBCNSVP",$J,""),-1)+1
D SET^IBCNSP(START,OFFSET,$$RJ^XLFSTR("Coord. Benefits: ",19)_Y)
;
; IB*2*452 - esg - display Pharmacy fields if they exist
I $P(IBCDFND4,U,5)'=""!($P(IBCDFND4,U,6)'="") D
. N G,IBY S G=+$P(IBCDFND4,U,5),IBY=""
. I G S IBY=$$GET1^DIQ(9002313.19,G_",",.01)_" - "_$$GET1^DIQ(9002313.19,G_",",.02)
. S START=$O(^TMP("IBCNSVP",$J,""),-1)+1
. D SET^IBCNSP(START,OFFSET,$$RJ^XLFSTR("Rx Relationship: ",19)_IBY)
. D SET^IBCNSP(START,OFFSET,$$RJ^XLFSTR("Rx Person Code: ",19)_$P(IBCDFND4,U,6))
. Q
; Two blank lines at end of section
S START=$O(^TMP("IBCNSVP",$J,""),-1)+1
D SET^IBCNSP(START,OFFSET," ")
Q
;
PRV ; Provider and contact info IB*2*497 move provider contact info so that prints after employer related info
; inputs
; IBCDFND,IBCDFND4 - data strings equal to the 0 and 4 subscripts of the INSURANCE TYPE Subfile (2.312) entry
; output
; - an entry at the nth node of ^TMP("IBCNSVP",$J,n)
N OFFSET,START
S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2
D SET^IBCNSP(START,OFFSET,"Primary Provider: "_$P(IBCDFND4,U,1))
D SET^IBCNSP(START+1,OFFSET," Prim Prov Phone: "_$P(IBCDFND4,U,2))
D SET^IBCNSP(START+2,2," ")
Q
;
VER ; -- Entered/Verfied Region
N OFFSET,START,EIVFLG
S EIVFLG=+$P(IBCDFND4,U,4)
S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2
S IB1ST("VERIFY")=START
D SET^IBCNSP(START,OFFSET," User Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET," Entered By: "_$E($P($G(^VA(200,+$P(IBCDFND1,U,2),0)),U,1),1,20))
D SET^IBCNSP(START+2,OFFSET," Entered On: "_$$DAT1^IBOUTL(+IBCDFND1))
;D SET^IBCNSP(START+3,OFFSET,"Last Verified By: "_$S(EIVFLG:"AUTOUPDATE,IB-eIV",1:$E($P($G(^VA(200,+$P(IBCDFND1,U,4),0)),U,1),1,20)))
D SET^IBCNSP(START+3,OFFSET,"Last Verified By: "_$E($P($G(^VA(200,+$P(IBCDFND1,U,4),0)),U,1),1,20))
D SET^IBCNSP(START+4,OFFSET,"Last Verified On: "_$$DAT1^IBOUTL(+$P(IBCDFND1,U,3)))
;D SET^IBCNSP(START+5,OFFSET," Last Updated By: "_$S(EIVFLG:"AUTOUPDATE,IB-eIV",1:$E($P($G(^VA(200,+$P(IBCDFND1,U,6),0)),U,1),1,20)))
D SET^IBCNSP(START+5,OFFSET," Last Updated By: "_$E($P($G(^VA(200,+$P(IBCDFND1,U,6),0)),U,1),1,20))
D SET^IBCNSP(START+6,OFFSET," Last Updated On: "_$$DAT1^IBOUTL(+$P(IBCDFND1,U,5)))
D SET^IBCNSP(START+7,2," ") ; 2 blank lines to end section
D SET^IBCNSP(START+8,2," ")
VERQ Q
;
ID ; Subscriber and patient primary and secondary ID's and qualifiers
NEW START,OFFSET,IBL,G,PCE,QUAL,QUAL1
S G=IBCDFND5
S (START,IBL)=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2
S IB1ST("ID")=START
D SET^IBCNSP(START,OFFSET," Insurance Company ID Numbers (use Subscriber Update Action) ",IORVON,IORVOFF)
D SPLIT(OFFSET," Subscriber ID: ",$P(IBCDFND7,U,2),.DATARRY)
S (SAV,X1)=0 F S X1=$O(DATARRY(X1)) Q:'X1 D
. S IBL=IBL+1
. D SET^IBCNSP(IBL,OFFSET,DATARRY(X1))
;
F PCE=3,5,7 D ; subscriber secondary IDs
. I $P(G,U,PCE)="" Q ; no secondary ID#
. S QUAL=$P(G,U,PCE-1) ; internal qualifier code
. S QUAL1=$S(QUAL="23":"Client#",QUAL="IG":"Ins. Policy#",QUAL="SY":"SSN",1:"Unknown")
. S IBL=IBL+1
. D SET^IBCNSP(IBL,OFFSET,"Subscriber Secondary ID: "_$P(G,U,PCE))
. D SET^IBCNSP(IBL,52,"ID Qual: "_QUAL_" ("_QUAL1_")")
. Q
;
; patient=subscriber so skip over patient ID# display
I +$P(IBCDFND,U,16)=1 G ID1
;
S IBL=IBL+1 D SET^IBCNSP(IBL,2," ") ; blank line
S IBL=IBL+1
D SET^IBCNSP(IBL,OFFSET," Patient Primary ID: "_$P(G,U,1))
;
F PCE=9,11,13 D ; patient secondary IDs
. I $P(G,U,PCE)="" Q ; no secondary ID#
. S QUAL=$P(G,U,PCE-1) ; internal qualifier code
. S QUAL1=$S(QUAL="23":"Client#",QUAL="IG":"Ins. Policy#",QUAL="SY":"SSN",1:"Unknown")
. S IBL=IBL+1
. D SET^IBCNSP(IBL,OFFSET," Patient Secondary ID: "_$P(G,U,PCE))
. D SET^IBCNSP(IBL,52,"ID Qual: "_QUAL_" ("_QUAL1_")")
. Q
;
ID1 ; end of section - 2 blank lines
S IBL=IBL+1 D SET^IBCNSP(IBL,2," ")
S IBL=IBL+1 D SET^IBCNSP(IBL,2," ")
IDQ ;
Q
;
RIDER ; -- Personal policy riders
N OFFSET,START,IBI,IBL,IBPR,IBPRD
S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2,IBL=0
D SET^IBCNSP(START,OFFSET," Personal Riders ",IORVON,IORVOFF)
S IBI="" F S IBI=$O(^IBA(355.7,"APP",DFN,IBCDFN,IBI)) Q:'IBI S IBPR=$O(^(IBI,0)),IBPRD=+$G(^IBA(355.7,IBPR,0)),IBL=IBL+1 D
. D SET^IBCNSP(START+IBL,OFFSET," Rider #"_IBL_": "_$$EXPAND^IBTRE(355.7,.01,IBPRD))
. Q
S IBL=IBL+1 D SET^IBCNSP(START+IBL,OFFSET," ")
S IBL=IBL+1 D SET^IBCNSP(START+IBL,OFFSET," ")
Q
;
AI ; -- Add ins. verification entry
; called from ai^ibcnsp1
;
; -- see if current inpatient
D INP^VADPT I +VAIN(1) D
.S IBTRN=$O(^IBT(356,"AD",+VAIN(1),0))
;
S IBXIFN=$O(^IBE(356.11,"ACODE",85,0))
;
; -- if not tracking id allow selecting
I '$G(IBTRN) D G:IBQUIT AIQ
.W !,"You can now enter a contact and relate it to a Claims Tracking Admission entry."
.S DIC("A")="Select RELATED ADMISSION DATE: "
.S DIC="^IBT(356,",DIC(0)="AEQ",D="ADFN"_DFN,DIC("S")="I $P(^(0),U,5)"
.D IX^DIC K DA,DR,DIC,DIE I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 Q
.I +Y>1 S IBTRN=+Y
;
I '$G(IBTRN) W !!,"Warning: This contact is not associated with any care in Claims Tracking.",!,"You may only edit or view this contact using this action.",!
;
; -- select date
S IBOK=0,IBI=0 F S IBI=$O(^IBT(356.2,"D",DFN,IBI)) Q:'IBI I $P($G(^IBT(356.2,+IBI,0)),U,4)=IBXIFN,$P($G(^(1)),U,5)=IBCDFN S IBOK=1
I IBOK D G:IBQUIT AIQ
.S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: "
.S X="??",DIC(0)="EQ",DIC("S")="I $P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN" ;,DLAYGO=356.2
.S D="ADFN"_DFN
.D IX^DIC K DIC,DR,DA,DIE,D I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1
;
S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: ",DIC("B")="TODAY"
S DIC("DR")=".02////"_$G(IBTRN)_";.04////"_IBXIFN_";.05////"_DFN_";.19////1;1.01///NOW;1.02////"_DUZ_";1.05////"_IBCDFN
S DIC(0)="AEQL",DIC("S")="I $P(^(0),U,5)=DFN,$P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN",DLAYGO=356.2
D ^DIC K DIC
I $D(DTOUT)!($D(DUOUT))!(+Y<1) G AIQ
S IBTRC=+Y
I $G(IBTRC),$G(IBTRN),'$P(^IBT(356.2,+IBTRC,0),U,2) S DA=IBTRC,DIE="^IBT(356.2,",DR=".02////"_$G(IBTRN) D ^DIE
;
; -- edit ins ver type
D EDIT^IBTRCD1("[IBT INS VERIFICATION]",1)
AIQ Q
;
SPLIT(OFFSET,LABEL,DATA,DATARRY) ; ib*2*497 reformat data that is too large to fit on one line
;
; INPUTS
; OFFSET - left margin starting point (e.g., 2)
; LABEL - the data label that gets displayed alongside the actual data (e.g."subscriber name:)
; DATA - the value to be set for display on a line (e.g., IB, PATIENT")
; OUTPUT
; DATARRY - an array which contains the data to be displayed on more than 1 line
;
N STRING,I,SAVPOS,QUIT
S STRING=LABEL_DATA
I $L(STRING)+OFFSET<81 S DATARRY(1)=STRING Q
S DATARRY(1)=$E(STRING,1,80-OFFSET)
S SAVPOS=$L(DATARRY(1))
S QUIT=0 F I=2:1 D Q:QUIT
. S DATARRY(I)=$$REPEAT^XLFSTR(" ",$L(LABEL))_$E(STRING,SAVPOS+1,$L(STRING))
. I $TR(DATARRY(I)," ")']"" K DATARRY(I) S QUIT=1 Q
. I $L(DATARRY(I))+OFFSET>80 S DATARRY(I)=$E(DATARRY(I),1,80-OFFSET) S SAVPOS=SAVPOS+$L(DATARRY(I)) Q
. S QUIT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSP01 8452 printed Jan 18, 2025@03:19:02 Page 2
IBCNSP01 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993
+1 ;;2.0;INTEGRATED BILLING;**43,52,85,251,371,377,416,452,497,595**;21-MAR-94;Build 29
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
% DO SUBSC
DO RIDER
+1 QUIT
+2 ;
SUBSC ; -- subscriber region ;IB*2*497 move subscriber lines around
+1 NEW OFFSET,START,RX,DATARRY,X1,SAV
+2 ;IB*2*497
SET START=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
SET OFFSET=2
SET RX=0
+3 DO SET^IBCNSP(START,OFFSET," Subscriber Information ",IORVON,IORVOFF)
+4 SET Y=$PIECE(IBCDFND,U,6)
SET C=$PIECE(^DD(2.312,6,0),U,2)
DO Y^DIQ
+5 DO SET^IBCNSP(START+1,OFFSET,$$RJ^XLFSTR("Whose Insurance: ",19)_Y)
+6 DO SPLIT(OFFSET,$$RJ^XLFSTR("Subscriber Name: ",19),$PIECE(IBCDFND7,U),.DATARRY)
+7 SET (SAV,X1)=0
FOR
SET X1=$ORDER(DATARRY(X1))
if 'X1
QUIT
Begin DoDot:1
+8 SET START=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
+9 DO SET^IBCNSP(START,OFFSET,DATARRY(X1))
End DoDot:1
+10 SET Y=$PIECE(IBCDFND4,U,3)
SET C=$PIECE(^DD(2.312,4.03,0),U,2)
DO Y^DIQ
+11 SET START=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
+12 DO SET^IBCNSP(START,OFFSET,$$RJ^XLFSTR("Relationship: ",19)_Y)
+13 KILL DATARRY
DO SPLIT(OFFSET,$$RJ^XLFSTR("Primary ID: ",19),$PIECE(IBCDFND7,U,2),.DATARRY)
+14 SET X1=0
FOR
SET X1=$ORDER(DATARRY(X1))
if 'X1
QUIT
Begin DoDot:1
+15 SET START=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
+16 DO SET^IBCNSP(START,OFFSET,DATARRY(X1))
End DoDot:1
+17 SET Y=$PIECE(IBCDFND,U,20)
SET C=$PIECE(^DD(2.312,.2,0),U,2)
DO Y^DIQ
+18 SET START=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
+19 DO SET^IBCNSP(START,OFFSET,$$RJ^XLFSTR("Coord. Benefits: ",19)_Y)
+20 ;
+21 ; IB*2*452 - esg - display Pharmacy fields if they exist
+22 IF $PIECE(IBCDFND4,U,5)'=""!($PIECE(IBCDFND4,U,6)'="")
Begin DoDot:1
+23 NEW G,IBY
SET G=+$PIECE(IBCDFND4,U,5)
SET IBY=""
+24 IF G
SET IBY=$$GET1^DIQ(9002313.19,G_",",.01)_" - "_$$GET1^DIQ(9002313.19,G_",",.02)
+25 SET START=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
+26 DO SET^IBCNSP(START,OFFSET,$$RJ^XLFSTR("Rx Relationship: ",19)_IBY)
+27 DO SET^IBCNSP(START,OFFSET,$$RJ^XLFSTR("Rx Person Code: ",19)_$PIECE(IBCDFND4,U,6))
+28 QUIT
End DoDot:1
+29 ; Two blank lines at end of section
+30 SET START=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
+31 DO SET^IBCNSP(START,OFFSET," ")
+32 QUIT
+33 ;
PRV ; Provider and contact info IB*2*497 move provider contact info so that prints after employer related info
+1 ; inputs
+2 ; IBCDFND,IBCDFND4 - data strings equal to the 0 and 4 subscripts of the INSURANCE TYPE Subfile (2.312) entry
+3 ; output
+4 ; - an entry at the nth node of ^TMP("IBCNSVP",$J,n)
+5 NEW OFFSET,START
+6 SET START=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
SET OFFSET=2
+7 DO SET^IBCNSP(START,OFFSET,"Primary Provider: "_$PIECE(IBCDFND4,U,1))
+8 DO SET^IBCNSP(START+1,OFFSET," Prim Prov Phone: "_$PIECE(IBCDFND4,U,2))
+9 DO SET^IBCNSP(START+2,2," ")
+10 QUIT
+11 ;
VER ; -- Entered/Verfied Region
+1 NEW OFFSET,START,EIVFLG
+2 SET EIVFLG=+$PIECE(IBCDFND4,U,4)
+3 SET START=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
SET OFFSET=2
+4 SET IB1ST("VERIFY")=START
+5 DO SET^IBCNSP(START,OFFSET," User Information ",IORVON,IORVOFF)
+6 DO SET^IBCNSP(START+1,OFFSET," Entered By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(IBCDFND1,U,2),0)),U,1),1,20))
+7 DO SET^IBCNSP(START+2,OFFSET," Entered On: "_$$DAT1^IBOUTL(+IBCDFND1))
+8 ;D SET^IBCNSP(START+3,OFFSET,"Last Verified By: "_$S(EIVFLG:"AUTOUPDATE,IB-eIV",1:$E($P($G(^VA(200,+$P(IBCDFND1,U,4),0)),U,1),1,20)))
+9 DO SET^IBCNSP(START+3,OFFSET,"Last Verified By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(IBCDFND1,U,4),0)),U,1),1,20))
+10 DO SET^IBCNSP(START+4,OFFSET,"Last Verified On: "_$$DAT1^IBOUTL(+$PIECE(IBCDFND1,U,3)))
+11 ;D SET^IBCNSP(START+5,OFFSET," Last Updated By: "_$S(EIVFLG:"AUTOUPDATE,IB-eIV",1:$E($P($G(^VA(200,+$P(IBCDFND1,U,6),0)),U,1),1,20)))
+12 DO SET^IBCNSP(START+5,OFFSET," Last Updated By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(IBCDFND1,U,6),0)),U,1),1,20))
+13 DO SET^IBCNSP(START+6,OFFSET," Last Updated On: "_$$DAT1^IBOUTL(+$PIECE(IBCDFND1,U,5)))
+14 ; 2 blank lines to end section
DO SET^IBCNSP(START+7,2," ")
+15 DO SET^IBCNSP(START+8,2," ")
VERQ QUIT
+1 ;
ID ; Subscriber and patient primary and secondary ID's and qualifiers
+1 NEW START,OFFSET,IBL,G,PCE,QUAL,QUAL1
+2 SET G=IBCDFND5
+3 SET (START,IBL)=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
SET OFFSET=2
+4 SET IB1ST("ID")=START
+5 DO SET^IBCNSP(START,OFFSET," Insurance Company ID Numbers (use Subscriber Update Action) ",IORVON,IORVOFF)
+6 DO SPLIT(OFFSET," Subscriber ID: ",$PIECE(IBCDFND7,U,2),.DATARRY)
+7 SET (SAV,X1)=0
FOR
SET X1=$ORDER(DATARRY(X1))
if 'X1
QUIT
Begin DoDot:1
+8 SET IBL=IBL+1
+9 DO SET^IBCNSP(IBL,OFFSET,DATARRY(X1))
End DoDot:1
+10 ;
+11 ; subscriber secondary IDs
FOR PCE=3,5,7
Begin DoDot:1
+12 ; no secondary ID#
IF $PIECE(G,U,PCE)=""
QUIT
+13 ; internal qualifier code
SET QUAL=$PIECE(G,U,PCE-1)
+14 SET QUAL1=$SELECT(QUAL="23":"Client#",QUAL="IG":"Ins. Policy#",QUAL="SY":"SSN",1:"Unknown")
+15 SET IBL=IBL+1
+16 DO SET^IBCNSP(IBL,OFFSET,"Subscriber Secondary ID: "_$PIECE(G,U,PCE))
+17 DO SET^IBCNSP(IBL,52,"ID Qual: "_QUAL_" ("_QUAL1_")")
+18 QUIT
End DoDot:1
+19 ;
+20 ; patient=subscriber so skip over patient ID# display
+21 IF +$PIECE(IBCDFND,U,16)=1
GOTO ID1
+22 ;
+23 ; blank line
SET IBL=IBL+1
DO SET^IBCNSP(IBL,2," ")
+24 SET IBL=IBL+1
+25 DO SET^IBCNSP(IBL,OFFSET," Patient Primary ID: "_$PIECE(G,U,1))
+26 ;
+27 ; patient secondary IDs
FOR PCE=9,11,13
Begin DoDot:1
+28 ; no secondary ID#
IF $PIECE(G,U,PCE)=""
QUIT
+29 ; internal qualifier code
SET QUAL=$PIECE(G,U,PCE-1)
+30 SET QUAL1=$SELECT(QUAL="23":"Client#",QUAL="IG":"Ins. Policy#",QUAL="SY":"SSN",1:"Unknown")
+31 SET IBL=IBL+1
+32 DO SET^IBCNSP(IBL,OFFSET," Patient Secondary ID: "_$PIECE(G,U,PCE))
+33 DO SET^IBCNSP(IBL,52,"ID Qual: "_QUAL_" ("_QUAL1_")")
+34 QUIT
End DoDot:1
+35 ;
ID1 ; end of section - 2 blank lines
+1 SET IBL=IBL+1
DO SET^IBCNSP(IBL,2," ")
+2 SET IBL=IBL+1
DO SET^IBCNSP(IBL,2," ")
IDQ ;
+1 QUIT
+2 ;
RIDER ; -- Personal policy riders
+1 NEW OFFSET,START,IBI,IBL,IBPR,IBPRD
+2 SET START=$ORDER(^TMP("IBCNSVP",$JOB,""),-1)+1
SET OFFSET=2
SET IBL=0
+3 DO SET^IBCNSP(START,OFFSET," Personal Riders ",IORVON,IORVOFF)
+4 SET IBI=""
FOR
SET IBI=$ORDER(^IBA(355.7,"APP",DFN,IBCDFN,IBI))
if 'IBI
QUIT
SET IBPR=$ORDER(^(IBI,0))
SET IBPRD=+$GET(^IBA(355.7,IBPR,0))
SET IBL=IBL+1
Begin DoDot:1
+5 DO SET^IBCNSP(START+IBL,OFFSET," Rider #"_IBL_": "_$$EXPAND^IBTRE(355.7,.01,IBPRD))
+6 QUIT
End DoDot:1
+7 SET IBL=IBL+1
DO SET^IBCNSP(START+IBL,OFFSET," ")
+8 SET IBL=IBL+1
DO SET^IBCNSP(START+IBL,OFFSET," ")
+9 QUIT
+10 ;
AI ; -- Add ins. verification entry
+1 ; called from ai^ibcnsp1
+2 ;
+3 ; -- see if current inpatient
+4 DO INP^VADPT
IF +VAIN(1)
Begin DoDot:1
+5 SET IBTRN=$ORDER(^IBT(356,"AD",+VAIN(1),0))
End DoDot:1
+6 ;
+7 SET IBXIFN=$ORDER(^IBE(356.11,"ACODE",85,0))
+8 ;
+9 ; -- if not tracking id allow selecting
+10 IF '$GET(IBTRN)
Begin DoDot:1
+11 WRITE !,"You can now enter a contact and relate it to a Claims Tracking Admission entry."
+12 SET DIC("A")="Select RELATED ADMISSION DATE: "
+13 SET DIC="^IBT(356,"
SET DIC(0)="AEQ"
SET D="ADFN"_DFN
SET DIC("S")="I $P(^(0),U,5)"
+14 DO IX^DIC
KILL DA,DR,DIC,DIE
IF $DATA(DUOUT)!($DATA(DTOUT))
SET IBQUIT=1
QUIT
+15 IF +Y>1
SET IBTRN=+Y
End DoDot:1
if IBQUIT
GOTO AIQ
+16 ;
+17 IF '$GET(IBTRN)
WRITE !!,"Warning: This contact is not associated with any care in Claims Tracking.",!,"You may only edit or view this contact using this action.",!
+18 ;
+19 ; -- select date
+20 SET IBOK=0
SET IBI=0
FOR
SET IBI=$ORDER(^IBT(356.2,"D",DFN,IBI))
if 'IBI
QUIT
IF $PIECE($GET(^IBT(356.2,+IBI,0)),U,4)=IBXIFN
IF $PIECE($GET(^(1)),U,5)=IBCDFN
SET IBOK=1
+21 IF IBOK
Begin DoDot:1
+22 SET DIC="^IBT(356.2,"
SET DIC("A")="Select Contact Date: "
+23 ;,DLAYGO=356.2
SET X="??"
SET DIC(0)="EQ"
SET DIC("S")="I $P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN"
+24 SET D="ADFN"_DFN
+25 DO IX^DIC
KILL DIC,DR,DA,DIE,D
IF $DATA(DUOUT)!($DATA(DTOUT))
SET IBQUIT=1
End DoDot:1
if IBQUIT
GOTO AIQ
+26 ;
+27 SET DIC="^IBT(356.2,"
SET DIC("A")="Select Contact Date: "
SET DIC("B")="TODAY"
+28 SET DIC("DR")=".02////"_$GET(IBTRN)_";.04////"_IBXIFN_";.05////"_DFN_";.19////1;1.01///NOW;1.02////"_DUZ_";1.05////"_IBCDFN
+29 SET DIC(0)="AEQL"
SET DIC("S")="I $P(^(0),U,5)=DFN,$P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN"
SET DLAYGO=356.2
+30 DO ^DIC
KILL DIC
+31 IF $DATA(DTOUT)!($DATA(DUOUT))!(+Y<1)
GOTO AIQ
+32 SET IBTRC=+Y
+33 IF $GET(IBTRC)
IF $GET(IBTRN)
IF '$PIECE(^IBT(356.2,+IBTRC,0),U,2)
SET DA=IBTRC
SET DIE="^IBT(356.2,"
SET DR=".02////"_$GET(IBTRN)
DO ^DIE
+34 ;
+35 ; -- edit ins ver type
+36 DO EDIT^IBTRCD1("[IBT INS VERIFICATION]",1)
AIQ QUIT
+1 ;
SPLIT(OFFSET,LABEL,DATA,DATARRY) ; ib*2*497 reformat data that is too large to fit on one line
+1 ;
+2 ; INPUTS
+3 ; OFFSET - left margin starting point (e.g., 2)
+4 ; LABEL - the data label that gets displayed alongside the actual data (e.g."subscriber name:)
+5 ; DATA - the value to be set for display on a line (e.g., IB, PATIENT")
+6 ; OUTPUT
+7 ; DATARRY - an array which contains the data to be displayed on more than 1 line
+8 ;
+9 NEW STRING,I,SAVPOS,QUIT
+10 SET STRING=LABEL_DATA
+11 IF $LENGTH(STRING)+OFFSET<81
SET DATARRY(1)=STRING
QUIT
+12 SET DATARRY(1)=$EXTRACT(STRING,1,80-OFFSET)
+13 SET SAVPOS=$LENGTH(DATARRY(1))
+14 SET QUIT=0
FOR I=2:1
Begin DoDot:1
+15 SET DATARRY(I)=$$REPEAT^XLFSTR(" ",$LENGTH(LABEL))_$EXTRACT(STRING,SAVPOS+1,$LENGTH(STRING))
+16 IF $TRANSLATE(DATARRY(I)," ")']""
KILL DATARRY(I)
SET QUIT=1
QUIT
+17 IF $LENGTH(DATARRY(I))+OFFSET>80
SET DATARRY(I)=$EXTRACT(DATARRY(I),1,80-OFFSET)
SET SAVPOS=SAVPOS+$LENGTH(DATARRY(I))
QUIT
+18 SET QUIT=1
End DoDot:1
if QUIT
QUIT
+19 QUIT
