IBCNBCD7.m

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 ---IBCNBCD7   2379     printed  Mar 13, 2025@21:18:43                                                                                                                                                                                                    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