IBCNBLP ;ALB/ARH-Ins Buffer: LM buffer process screen ;1 Jun 97
;;2.0;INTEGRATED BILLING;**82,497,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; - main entry point for screen
D EN^VALM("IBCNB INSURANCE BUFFER PROCESS")
Q
;
HDR ; header code for list manager display
N IBX,IB0,IBY,VADM,VA,VAERR S IBX=""
;I +DFN D DEM^VADPT S IBX=$E(VADM(1),1,28),IBX=IBX_$J("",35-$L(IBX))_$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4)
;S VALMHDR(1)=IBX
;S VALMHDR(2)=" "
I +DFN D DEM^VADPT S IBX=$E(VADM(1),1,28)
S VALMHDR(1)=IBX
S VALMHDR(2)=$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4)
S IB0=$G(^IBA(355.33,IBBUFDA,21))
S IBY=$E($$GET1^DIQ(355.3,IBBUFDA,2.02),1,13),IBX=$P($G(^DIC(5,+$P(IB0,U,5),0)),U,2),IBY=IBY_$S(IBY'=""&(IBX'=""):", ",1:"")_IBX ; 516 - baa
S IBY=$E($P(IB0,U,1),1,20)_$S(IBY'="":", ",1:"")_IBY,IBY=$S(IBY'="":" ("_IBY_")",1:"")
S IBX=$E($P($G(^IBA(355.33,IBBUFDA,20)),U,1),1,18)_IBY,IBX=$J("",40-($L(IBX)\2))_IBX
S VALMHDR(3)=IBX
I +$G(IBCNSCRN) D GRPHDR(IBBUFDA) Q
D PATHDR(IBBUFDA)
Q
;
INIT ; initialization for list manager list, ifn of record to display required IBBUFDA
K ^TMP("IBCNBLP",$J),^TMP("IBCNBLPX",$J) N IBINSDA
I '$G(IBBUFDA) S VALMQUIT="" Q
S IBINSDA=+$G(IBCNSCRN)
S DFN=+$G(^IBA(355.33,IBBUFDA,60))
D BLD
Q
;
HELP ; list manager help
D FULL^VALM1
W !!,"This screen displays a summary of the chosen Buffer entry in the header."
W !!,"The list portion of the screen may display either:"
W !,?5,"1) a list of all of the patient's current and past insurance policies,"
W !,?8,"followed by a list of any Group/Plan that has a Group Name or ",!,?8,"Group Number that may match the Buffer entry's."
W !,?5,"2) a list of all of the Group/Plans for a user specified insurance company."
W !!,"Use the 'Insurance Co/Patient' action to toggle between these two screens."
W !!,"Flags: '~' company/group is inactive '-' individual patient policy"
W !!,"Bold Data: If one of the following Buffer File entry data elements matches all",!,"or the first part of the "
W "corresponding data element of the policy or group/plan",!,"being displayed then the matching part of the data element will be displayed in",!,"bold characters:"
W !," Subscriber Id, Insurance Company Name, Group Number, Group Name, Type of Plan"
W !!,"Bold Number: On the Group/Plan lists, the number preceding the group/plan being",!,"displayed will be in bold if the patient is already a member of that plan."
W !!,"The IB INSURANCE SUPERVISOR key is required to either Accept or Reject an entry."
D PAUSE^VALM1 S VALMBCK="R"
Q
;
EXIT ; exit list manager option and clean up
K ^TMP("IBCNBLP",$J),^TMP("IBCNBLPX",$J),DFN,IBCNSCRN
D CLEAR^VALM1
Q
;
BLD ; build screen display
;
N PATCMP,GRPCMP,CNT S VALMCNT=0,CNT=0
;
S PATCMP=$$PATDATA(IBBUFDA),GRPCMP=$$GRPDATA(IBBUFDA)
;
I +$G(IBCNSCRN) D GRPLST^IBCNBLP1(.CNT,IBINSDA,DFN,GRPCMP) Q
;
D PATLST^IBCNBLP1(.CNT,DFN,PATCMP)
D SRCHLST^IBCNBLP1(.CNT,DFN,$P(PATCMP,U,1),$P(GRPCMP,U,1),$P(GRPCMP,U,2))
Q
;
DATE(X) ;
N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
Q Y
;
;
PATHDR(IBBUFDA) ; additional header lines: display buffer entry for display of existing patient's insurance screen
Q:'IBBUFDA N IBX,IBY,IB20,IB40,IB60 S IBX=""
S IB20=$G(^IBA(355.33,IBBUFDA,20)),IB40=$G(^IBA(355.33,IBBUFDA,40)),IB60=$G(^IBA(355.33,IBBUFDA,60))
;
S IBX="" I 'IB40 S IBY="-" S IBX=$$SETSTR^VALM1(IBY,IBX,4,1)
S IBY=$P(IB20,U,1) S IBX=$$SETSTR^VALM1(IBY,IBX,5,18)
;IB*2.0*516/BAA - Use HIPAA compliant fields.
S IBY=$$GET1^DIQ(355.33,IBBUFDA,90.02) S IBX=$$SETSTR^VALM1(IBY,IBX,25,13) ;516 - baa
S IBY=$$GET1^DIQ(355.33,IBBUFDA,90.03) S IBX=$$SETSTR^VALM1(IBY,IBX,40,13) ;516 - baa
S IBY=$P(IB60,U,6),IBY=$$EXPAND^IBTRE(355.33,60.06,IBY) S IBX=$$SETSTR^VALM1(IBY,IBX,55,6)
S IBY=$$DATE($P(IB60,U,2)) S IBX=$$SETSTR^VALM1(IBY,IBX,63,8)
S IBY=$$DATE($P(IB60,U,3)) S IBX=$$SETSTR^VALM1(IBY,IBX,73,8)
S VALMHDR(4)=IBX
Q
;
GRPHDR(IBBUFDA) ; additional header lines: display buffer entry for display of other insurance group plans screen
Q:'IBBUFDA N IBX,IBY,IB40 S IBX=""
S IB40=$G(^IBA(355.33,IBBUFDA,40))
;
S IBX="" I 'IB40 S IBY="-" S IBX=$$SETSTR^VALM1(IBY,IBX,5,1)
;S IBY=$P(IB40,U,2) S IBX=$$SETSTR^VALM1(IBY,IBX,6,20)
;S IBY=$P(IB40,U,3) S IBX=$$SETSTR^VALM1(IBY,IBX,30,17)
S IBY=$$GET1^DIQ(355.33,IBBUFDA,90.01) S IBX=$$SETSTR^VALM1(IBY,IBX,6,80) ; 516 - baa - new grp nam field
S VALMHDR(4)=IBX
S IBY=$$GET1^DIQ(355.33,IBBUFDA,90.02) S IBX=$$SETSTR^VALM1(IBY,IBX,6,55) ; 516 - baa - new grp num field
S VALMHDR(5)=IBX
;S IBY=$P(IB40,U,9) I +IBY S IBY=$P($G(^IBE(355.1,+IBY,0)),U,1) S IBX=$$SETSTR^VALM1(IBY,IBX,50,30)
S IBY=$P(IB40,U,9) I +IBY S IBY=$P($G(^IBE(355.1,+IBY,0)),U,1) S IBX=$$SETSTR^VALM1(IBY,IBX,6,30)
S VALMHDR(6)=IBX
Q
;
PATDATA(IBBUFDA) ; create string of data from buffer entry to compare with data in existing insurance entries
; for the patient insurance list compare: INS COMPANY NAME ^ GROUP NUMBER ^ SUBSCRIBER ID
N IBX
S IBX=$P($G(^IBA(355.33,IBBUFDA,20)),U,1)_U_$$GET1^DIQ(355.33,IBBUFDA,90.02)_U_$$GET1^DIQ(355.33,IBBUFDA,90.03) ;516 - baa
Q IBX
;
GRPDATA(IBBUFDA) ; create string of data from buffer entry to compare with data in existing insurance entries
; for the group plan list compare: GROUP NAME ^ GROUP NUMBER ^ TYPE OF PLAN
N IBX,IBY,IBGNAM,IBGNUM
S IBY=$G(^IBA(355.33,IBBUFDA,40))
; 516 - baa - get new group name and number fields
S IBGNAM=$$GET1^DIQ(355.33,IBBUFDA,90.01)
S IBGNUM=$$GET1^DIQ(355.33,IBBUFDA,90.02)
S IBX=IBGNAM_U_IBGNUM_U_$P($G(^IBE(355.1,+$P(IBY,U,9),0)),U,1)
; end Patch 516 - baa
Q IBX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBLP 5802 printed Dec 13, 2024@02:14:07 Page 2
IBCNBLP ;ALB/ARH-Ins Buffer: LM buffer process screen ;1 Jun 97
+1 ;;2.0;INTEGRATED BILLING;**82,497,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; - main entry point for screen
+1 DO EN^VALM("IBCNB INSURANCE BUFFER PROCESS")
+2 QUIT
+3 ;
HDR ; header code for list manager display
+1 NEW IBX,IB0,IBY,VADM,VA,VAERR
SET IBX=""
+2 ;I +DFN D DEM^VADPT S IBX=$E(VADM(1),1,28),IBX=IBX_$J("",35-$L(IBX))_$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4)
+3 ;S VALMHDR(1)=IBX
+4 ;S VALMHDR(2)=" "
+5 IF +DFN
DO DEM^VADPT
SET IBX=$EXTRACT(VADM(1),1,28)
+6 SET VALMHDR(1)=IBX
+7 SET VALMHDR(2)=$PIECE(VADM(2),U,2)_" DOB: "_$PIECE(VADM(3),U,2)_" AGE: "_VADM(4)
+8 SET IB0=$GET(^IBA(355.33,IBBUFDA,21))
+9 ; 516 - baa
SET IBY=$EXTRACT($$GET1^DIQ(355.3,IBBUFDA,2.02),1,13)
SET IBX=$PIECE($GET(^DIC(5,+$PIECE(IB0,U,5),0)),U,2)
SET IBY=IBY_$SELECT(IBY'=""&(IBX'=""):", ",1:"")_IBX
+10 SET IBY=$EXTRACT($PIECE(IB0,U,1),1,20)_$SELECT(IBY'="":", ",1:"")_IBY
SET IBY=$SELECT(IBY'="":" ("_IBY_")",1:"")
+11 SET IBX=$EXTRACT($PIECE($GET(^IBA(355.33,IBBUFDA,20)),U,1),1,18)_IBY
SET IBX=$JUSTIFY("",40-($LENGTH(IBX)\2))_IBX
+12 SET VALMHDR(3)=IBX
+13 IF +$GET(IBCNSCRN)
DO GRPHDR(IBBUFDA)
QUIT
+14 DO PATHDR(IBBUFDA)
+15 QUIT
+16 ;
INIT ; initialization for list manager list, ifn of record to display required IBBUFDA
+1 KILL ^TMP("IBCNBLP",$JOB),^TMP("IBCNBLPX",$JOB)
NEW IBINSDA
+2 IF '$GET(IBBUFDA)
SET VALMQUIT=""
QUIT
+3 SET IBINSDA=+$GET(IBCNSCRN)
+4 SET DFN=+$GET(^IBA(355.33,IBBUFDA,60))
+5 DO BLD
+6 QUIT
+7 ;
HELP ; list manager help
+1 DO FULL^VALM1
+2 WRITE !!,"This screen displays a summary of the chosen Buffer entry in the header."
+3 WRITE !!,"The list portion of the screen may display either:"
+4 WRITE !,?5,"1) a list of all of the patient's current and past insurance policies,"
+5 WRITE !,?8,"followed by a list of any Group/Plan that has a Group Name or ",!,?8,"Group Number that may match the Buffer entry's."
+6 WRITE !,?5,"2) a list of all of the Group/Plans for a user specified insurance company."
+7 WRITE !!,"Use the 'Insurance Co/Patient' action to toggle between these two screens."
+8 WRITE !!,"Flags: '~' company/group is inactive '-' individual patient policy"
+9 WRITE !!,"Bold Data: If one of the following Buffer File entry data elements matches all",!,"or the first part of the "
+10 WRITE "corresponding data element of the policy or group/plan",!,"being displayed then the matching part of the data element will be displayed in",!,"bold characters:"
+11 WRITE !," Subscriber Id, Insurance Company Name, Group Number, Group Name, Type of Plan"
+12 WRITE !!,"Bold Number: On the Group/Plan lists, the number preceding the group/plan being",!,"displayed will be in bold if the patient is already a member of that plan."
+13 WRITE !!,"The IB INSURANCE SUPERVISOR key is required to either Accept or Reject an entry."
+14 DO PAUSE^VALM1
SET VALMBCK="R"
+15 QUIT
+16 ;
EXIT ; exit list manager option and clean up
+1 KILL ^TMP("IBCNBLP",$JOB),^TMP("IBCNBLPX",$JOB),DFN,IBCNSCRN
+2 DO CLEAR^VALM1
+3 QUIT
+4 ;
BLD ; build screen display
+1 ;
+2 NEW PATCMP,GRPCMP,CNT
SET VALMCNT=0
SET CNT=0
+3 ;
+4 SET PATCMP=$$PATDATA(IBBUFDA)
SET GRPCMP=$$GRPDATA(IBBUFDA)
+5 ;
+6 IF +$GET(IBCNSCRN)
DO GRPLST^IBCNBLP1(.CNT,IBINSDA,DFN,GRPCMP)
QUIT
+7 ;
+8 DO PATLST^IBCNBLP1(.CNT,DFN,PATCMP)
+9 DO SRCHLST^IBCNBLP1(.CNT,DFN,$PIECE(PATCMP,U,1),$PIECE(GRPCMP,U,1),$PIECE(GRPCMP,U,2))
+10 QUIT
+11 ;
DATE(X) ;
+1 NEW Y
SET Y=""
IF X?7N.E
SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+2 QUIT Y
+3 ;
+4 ;
PATHDR(IBBUFDA) ; additional header lines: display buffer entry for display of existing patient's insurance screen
+1 if 'IBBUFDA
QUIT
NEW IBX,IBY,IB20,IB40,IB60
SET IBX=""
+2 SET IB20=$GET(^IBA(355.33,IBBUFDA,20))
SET IB40=$GET(^IBA(355.33,IBBUFDA,40))
SET IB60=$GET(^IBA(355.33,IBBUFDA,60))
+3 ;
+4 SET IBX=""
IF 'IB40
SET IBY="-"
SET IBX=$$SETSTR^VALM1(IBY,IBX,4,1)
+5 SET IBY=$PIECE(IB20,U,1)
SET IBX=$$SETSTR^VALM1(IBY,IBX,5,18)
+6 ;IB*2.0*516/BAA - Use HIPAA compliant fields.
+7 ;516 - baa
SET IBY=$$GET1^DIQ(355.33,IBBUFDA,90.02)
SET IBX=$$SETSTR^VALM1(IBY,IBX,25,13)
+8 ;516 - baa
SET IBY=$$GET1^DIQ(355.33,IBBUFDA,90.03)
SET IBX=$$SETSTR^VALM1(IBY,IBX,40,13)
+9 SET IBY=$PIECE(IB60,U,6)
SET IBY=$$EXPAND^IBTRE(355.33,60.06,IBY)
SET IBX=$$SETSTR^VALM1(IBY,IBX,55,6)
+10 SET IBY=$$DATE($PIECE(IB60,U,2))
SET IBX=$$SETSTR^VALM1(IBY,IBX,63,8)
+11 SET IBY=$$DATE($PIECE(IB60,U,3))
SET IBX=$$SETSTR^VALM1(IBY,IBX,73,8)
+12 SET VALMHDR(4)=IBX
+13 QUIT
+14 ;
GRPHDR(IBBUFDA) ; additional header lines: display buffer entry for display of other insurance group plans screen
+1 if 'IBBUFDA
QUIT
NEW IBX,IBY,IB40
SET IBX=""
+2 SET IB40=$GET(^IBA(355.33,IBBUFDA,40))
+3 ;
+4 SET IBX=""
IF 'IB40
SET IBY="-"
SET IBX=$$SETSTR^VALM1(IBY,IBX,5,1)
+5 ;S IBY=$P(IB40,U,2) S IBX=$$SETSTR^VALM1(IBY,IBX,6,20)
+6 ;S IBY=$P(IB40,U,3) S IBX=$$SETSTR^VALM1(IBY,IBX,30,17)
+7 ; 516 - baa - new grp nam field
SET IBY=$$GET1^DIQ(355.33,IBBUFDA,90.01)
SET IBX=$$SETSTR^VALM1(IBY,IBX,6,80)
+8 SET VALMHDR(4)=IBX
+9 ; 516 - baa - new grp num field
SET IBY=$$GET1^DIQ(355.33,IBBUFDA,90.02)
SET IBX=$$SETSTR^VALM1(IBY,IBX,6,55)
+10 SET VALMHDR(5)=IBX
+11 ;S IBY=$P(IB40,U,9) I +IBY S IBY=$P($G(^IBE(355.1,+IBY,0)),U,1) S IBX=$$SETSTR^VALM1(IBY,IBX,50,30)
+12 SET IBY=$PIECE(IB40,U,9)
IF +IBY
SET IBY=$PIECE($GET(^IBE(355.1,+IBY,0)),U,1)
SET IBX=$$SETSTR^VALM1(IBY,IBX,6,30)
+13 SET VALMHDR(6)=IBX
+14 QUIT
+15 ;
PATDATA(IBBUFDA) ; create string of data from buffer entry to compare with data in existing insurance entries
+1 ; for the patient insurance list compare: INS COMPANY NAME ^ GROUP NUMBER ^ SUBSCRIBER ID
+2 NEW IBX
+3 ;516 - baa
SET IBX=$PIECE($GET(^IBA(355.33,IBBUFDA,20)),U,1)_U_$$GET1^DIQ(355.33,IBBUFDA,90.02)_U_$$GET1^DIQ(355.33,IBBUFDA,90.03)
+4 QUIT IBX
+5 ;
GRPDATA(IBBUFDA) ; create string of data from buffer entry to compare with data in existing insurance entries
+1 ; for the group plan list compare: GROUP NAME ^ GROUP NUMBER ^ TYPE OF PLAN
+2 NEW IBX,IBY,IBGNAM,IBGNUM
+3 SET IBY=$GET(^IBA(355.33,IBBUFDA,40))
+4 ; 516 - baa - get new group name and number fields
+5 SET IBGNAM=$$GET1^DIQ(355.33,IBBUFDA,90.01)
+6 SET IBGNUM=$$GET1^DIQ(355.33,IBBUFDA,90.02)
+7 SET IBX=IBGNAM_U_IBGNUM_U_$PIECE($GET(^IBE(355.1,+$PIECE(IBY,U,9),0)),U,1)
+8 ; end Patch 516 - baa
+9 QUIT IBX
