IBCNBCD7 ;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(SKPBLANK,IBFNAM,IBHOLD,IBXHOLD) ; called from SUB^IBCNBAC
S SKPBLANK=$G(SKPBLANK)
;
W @IOF
W ! D WRTFLD^IBCNBAC(" Subscriber Data: Patient Registration Patient Insurance Policy ",0,80,"BU")
;
I $G(IBFNAM)="DPT" S IBSET="DPT" D SBFLDS(IBSET,SKPBLANK,.IBHOLD,.IBXHOLD) Q
I $G(IBFNAM)="DGPR" S IBSET="DGPR" D SBFLDS(IBSET,SKPBLANK,.IBHOLD,.IBXHOLD) Q
I $G(IBFNAM)="" S IBSET="N" D SBFLDS(IBSET,SKPBLANK,.IBHOLD,.IBXHOLD) Q
Q
;
SBFLDS(IBSET,SKPBLANK,IBHOLD,IBXHOLD) ; accept each field and set into temp array
N IBX,IB1,IB2,IBSEL,IBDF,IBDRB,IBDRX,IBBUFVAL,IBEXTVAL,CHGCHK,IBFLDS,IBLBLS,IBADDS,IBLABEL,IBUSER
S CHGCHK=0
;
S IBSEL=$NA(^TMP($J,"IB BUFFER SELECTED"))
K @IBSEL
;
; -- get corresponding fields from routine IBCNBCD6 to populate data
D FIELDS^IBCNBCD6(IBSET_"FLD",.IBFLDS,.IBLBLS,.IBADDS)
S IBDF=$P($T(@(IBSET_"DR")+1^IBCNBCD6),";;",2),IBDRB=$P(IBDF,U,2),IBDRX=$P(IBDF,U,3)
;
;
F IBX=1:1:$L(IBDRB,";") I '$D(IBADDS(IBX)) D Q:$G(IBUSER)<0
. ;
. S IB1=$P(IBDRB,";",IBX),IB2=$P(IBDRX,";",IBX)
. ;
. S IBBUFVAL=$G(@IBHOLD@(2,IB1)),IBEXTVAL=$G(@IBXHOLD@(2,IB2)),IBLABEL=$G(IBLBLS(IB1))_":"
. ;
. D SBDIS(IBBUFVAL,IBEXTVAL,IBLABEL,SKPBLANK)
. ;
. I IBBUFVAL=IBEXTVAL Q
. I SKPBLANK,IBBUFVAL="" Q
. ;
. S CHGCHK=1
. S IBUSER=$$ACCEPT^IBCNBAC(IBBUFVAL,IBEXTVAL) Q:IBUSER<0
. I +IBUSER S @IBSEL@(IB1)=""
;
K DIR
D DMSG(CHGCHK),PAUSE^VALM1
Q
;
SBDIS(BFLD,IFLD,LABEL,SKPBLANK) ; write the two corresponding fields; one from buffer, one from ins files
N IBOVER,IBMERG,IBATTR
S (IBOVER,IBMERG,IBATTR)=""
;
; -- turn bold attributes on
I BFLD'=IFLD S (IBOVER,IBMERG,IBATTR)="B"
;
; -- skipping blanks, display skipped items without bold
I SKPBLANK,BFLD="" S (IBOVER,IBMERG,IBATTR)=""
;
; -- display a line of data to screen
D WRTLN^IBCNBAC(LABEL,BFLD,IFLD,IBOVER,IBMERG,IBATTR)
Q
;
DMSG(CHGCHK) ; Display message if there were no changes to accept
I CHGCHK=0 W !!,"There are no changes to be accepted, based on the method of update chosen." Q
I CHGCHK=1 W !!,"End of changes for SUBSCRIBER related data."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBCD7 2379 printed Dec 13, 2024@02:13:54 Page 2
IBCNBCD7 ;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(SKPBLANK,IBFNAM,IBHOLD,IBXHOLD) ; called from SUB^IBCNBAC
+1 SET SKPBLANK=$GET(SKPBLANK)
+2 ;
+3 WRITE @IOF
+4 WRITE !
DO WRTFLD^IBCNBAC(" Subscriber Data: Patient Registration Patient Insurance Policy ",0,80,"BU")
+5 ;
+6 IF $GET(IBFNAM)="DPT"
SET IBSET="DPT"
DO SBFLDS(IBSET,SKPBLANK,.IBHOLD,.IBXHOLD)
QUIT
+7 IF $GET(IBFNAM)="DGPR"
SET IBSET="DGPR"
DO SBFLDS(IBSET,SKPBLANK,.IBHOLD,.IBXHOLD)
QUIT
+8 IF $GET(IBFNAM)=""
SET IBSET="N"
DO SBFLDS(IBSET,SKPBLANK,.IBHOLD,.IBXHOLD)
QUIT
+9 QUIT
+10 ;
SBFLDS(IBSET,SKPBLANK,IBHOLD,IBXHOLD) ; accept each field and set into temp array
+1 NEW IBX,IB1,IB2,IBSEL,IBDF,IBDRB,IBDRX,IBBUFVAL,IBEXTVAL,CHGCHK,IBFLDS,IBLBLS,IBADDS,IBLABEL,IBUSER
+2 SET CHGCHK=0
+3 ;
+4 SET IBSEL=$NAME(^TMP($JOB,"IB BUFFER SELECTED"))
+5 KILL @IBSEL
+6 ;
+7 ; -- get corresponding fields from routine IBCNBCD6 to populate data
+8 DO FIELDS^IBCNBCD6(IBSET_"FLD",.IBFLDS,.IBLBLS,.IBADDS)
+9 SET IBDF=$PIECE($TEXT(@(IBSET_"DR")+1^IBCNBCD6),";;",2)
SET IBDRB=$PIECE(IBDF,U,2)
SET IBDRX=$PIECE(IBDF,U,3)
+10 ;
+11 ;
+12 FOR IBX=1:1:$LENGTH(IBDRB,";")
IF '$DATA(IBADDS(IBX))
Begin DoDot:1
+13 ;
+14 SET IB1=$PIECE(IBDRB,";",IBX)
SET IB2=$PIECE(IBDRX,";",IBX)
+15 ;
+16 SET IBBUFVAL=$GET(@IBHOLD@(2,IB1))
SET IBEXTVAL=$GET(@IBXHOLD@(2,IB2))
SET IBLABEL=$GET(IBLBLS(IB1))_":"
+17 ;
+18 DO SBDIS(IBBUFVAL,IBEXTVAL,IBLABEL,SKPBLANK)
+19 ;
+20 IF IBBUFVAL=IBEXTVAL
QUIT
+21 IF SKPBLANK
IF IBBUFVAL=""
QUIT
+22 ;
+23 SET CHGCHK=1
+24 SET IBUSER=$$ACCEPT^IBCNBAC(IBBUFVAL,IBEXTVAL)
if IBUSER<0
QUIT
+25 IF +IBUSER
SET @IBSEL@(IB1)=""
End DoDot:1
if $GET(IBUSER)<0
QUIT
+26 ;
+27 KILL DIR
+28 DO DMSG(CHGCHK)
DO PAUSE^VALM1
+29 QUIT
+30 ;
SBDIS(BFLD,IFLD,LABEL,SKPBLANK) ; write the two corresponding fields; one from buffer, one from ins files
+1 NEW IBOVER,IBMERG,IBATTR
+2 SET (IBOVER,IBMERG,IBATTR)=""
+3 ;
+4 ; -- turn bold attributes on
+5 IF BFLD'=IFLD
SET (IBOVER,IBMERG,IBATTR)="B"
+6 ;
+7 ; -- skipping blanks, display skipped items without bold
+8 IF SKPBLANK
IF BFLD=""
SET (IBOVER,IBMERG,IBATTR)=""
+9 ;
+10 ; -- display a line of data to screen
+11 DO WRTLN^IBCNBAC(LABEL,BFLD,IFLD,IBOVER,IBMERG,IBATTR)
+12 QUIT
+13 ;
DMSG(CHGCHK) ; Display message if there were no changes to accept
+1 IF CHGCHK=0
WRITE !!,"There are no changes to be accepted, based on the method of update chosen."
QUIT
+2 IF CHGCHK=1
WRITE !!,"End of changes for SUBSCRIBER related data."
+3 QUIT
