Routine: IB20P384

IB20P384 ;ALB/BDB - IB*2.0*384 POST INIT: ADD REASON NOT BILLABLE ;08-NOV-2007

 ;;2.0;INTEGRATED BILLING;**384**;21-MAR-94;Build 74

 ;;Per VHA Directive 2004-038, this routine should not be modified.

POST ;

 N IBA

 S IBA(1)="",IBA(2)="    IB*2*384 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA

 D SCREEN7 ; Recompile the Screen 7 input template

 D SCEIEDIT ; Edit SCEI's to be ECME selectable in Claims Tracking Non-Billable Reasons file(#356.8)

 D IBERRAD ; New IB328 'ROI form required for sensitive record' IB Error file (#350.8)

 ;populate new #350.9 field #11.02 and add one record with reject code=70 to the subfile #350.912

 ;for NON-COVERED DRUGS functionality; add new non-billable reason "NON COVERED DRUG PER PLAN"

 D NONCOVDR

 D NEWR ; add new RNB to CT RNB file (#356.8)

 S IBA(1)="",IBA(2)="    IB*2*384 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA

SCEIEDIT ; Edit SCEI's to be ECME selectable in Claims Tracking Non-Billable Reasons file(#356.8)

 N DD,DO,DLAYGO,DINUM,DIC,DIE,DA,DR,X,Y,IBA,IBFOUND,IBFOUND1,IBATFN,IBNUM,IBAT,IBFN,IBIEN

 S IBA(1)="",IBA(2)="      >> Editing Service Connected/Environmental Indicators to be ECME"

 S IBA(3)="      >> selectable in the Claims Tracking Non-Billable Reasons file (#356.8)"

 S IBFOUND1=""

 F IBNUM=1:1:8 S IBIEN=$O(^IBE(356.8,"B",$P("SC TREATMENT^AGENT ORANGE^IONIZING RADIATION^SOUTHWEST ASIA^MILITARY SEXUAL TRAUMA^HEAD/NECK CANCER^COMBAT VETERAN^PROJECT 112/SHAD",U,IBNUM),"")) D

 .S IBFOUND="" I +IBIEN S IBFOUND=$G(^IBE(356.8,IBIEN,0))

 .I IBFOUND="" S IBFOUND1=1 D MSG(" "),MSG("     *** ERROR: Entry "_$P("SC^AO^IR^SWA^MST^HNC^CV^SHAD",U,IBNUM)_" missing, could not edit") Q

 .S DR=".02////1;.03////0"

 .S DIE="^IBE(356.8,",DA=IBIEN D ^DIE K DIE,DA,DR,X,Y

 D:IBFOUND1="" MSG("         Done. Service Connected/Environmental Indicators edited")

 D:'(IBFOUND1="") MSG("     *** ERROR: One or more entries could not be edited")

SCEIQ D MES^XPDUTL(.IBA) K IBA

IBERRAD ; New IB328 'ROI form required for sensitive record' IB Error file (#350.8)

 N DD,DO,DINUM,DIC,DIE,DA,DR,X,Y,IBA,IBFOUND,IBATFN,IBAT,IBIEN

 S IBA(1)="      >> Adding IB328 'ROI form required for sensitive record'"

 S IBA(2)="      >> in the IB Error file (#350.8)"

 S IBAT="IB328",IBIEN=$G(^IBE(350.8,"AC",IBAT))

 S IBFOUND="" I +IBIEN S IBFOUND=$G(^IBE(350.8,IBIEN,0))

 I IBFOUND="IB328^ROI form required for sensitive record^IB328^1^3" D MSG("         Done. IB328 'ROI form required for sensitive record' already exists") G IBERRADQ

 I IBFOUND'="" D MSG(" "),MSG("     *** ERROR: Entry already exists, could not add") G IBERRADQ

 K DD,DO S DIC="^IBE(350.8,",DIC(0)="L",X=IBAT D FILE^DICN K DIC S IBIEN=+Y

 I Y<1 K X,Y D MSG(" "),MSG("     *** ERROR: New entry could not be added") G IBERRADQ

 S DR=".02////ROI form required for sensitive record;.03////IB328;.04////1;.05////3"

 S DIE="^IBE(350.8,",DA=+IBIEN D ^DIE K DIE,DA,DR,X,Y

 D MSG("         Done. IB328 'ROI form required for sensitive record'  added")

IBERRADQ D MES^XPDUTL(.IBA) K IBA

MSG(X) ;

 N IBX S IBX=$O(IBA(999999),-1) S:'IBX IBX=1 S IBX=IBX+1

 S IBA(IBX)=$G(X)

 ;populate fields for NON-COVERED DRUGS functionality

NONCOVDR ;

 I $P($G(^IBE(350.9,1,11)),U,2)>0 D  Q

  . D BMES^XPDUTL("      >>   Skipping: NON-COVERED DRUGS functionality has been already activated")

 N IBZZ,IBNREC

 D BMES^XPDUTL("      >> Populating new #350.9 fields for NON-COVERED DRUGS functionality")

 D BMES^XPDUTL("      >>   turning off the NON-COVERED DRUGS functionality by default")

 S IBZZ=$$FILLFLDS^IBNCPUT1(350.9,11.02,1,0)

 I IBZZ'>0 D BMES^XPDUTL("     *** ERROR: "_$P(IBZZ,U,3))

 I '$O(^IBE(350.9,1,12,"B","70",0)) D

 . D BMES^XPDUTL("      >>   adding '70 Product/Service Not Covered' as default reject code")

 . I $$INSITEM^IBNCPUT1(350.912,1,"70","","E")'>0 D BMES^XPDUTL("     *** ERROR: could not add")

 ;add a new non-billable reason "NON COVERED DRUG PER PLAN"

 ;to the file (#356.8) CLAIMS TRACKING NON-BILLABLE REASONS file

 I '$O(^IBE(356.8,"B","NON COVERED DRUG PER PLAN",0)) D

 . D BMES^XPDUTL("      >>   adding a new 'NON COVERED DRUG PER PLAN' non-billable reason to the file #356.8")

 . S IBNREC=$$INSITEM^IBNCPUT1(356.8,"","NON COVERED DRUG PER PLAN","","E") I IBZZ'>0 D BMES^XPDUTL("     *** ERROR: could not add") Q

 . D BMES^XPDUTL("      >>   setting the ECME FLAG to 'Yes'")

 . S IBZZ=$$FILLFLDS^IBNCPUT1(356.8,.02,+IBNREC,1) I IBZZ'>0 D BMES^XPDUTL("     *** ERROR: "_$P(IBZZ,U,3))

 . D BMES^XPDUTL("      >>   setting the ECME PAPER FLAG to 'No'")

 . S IBZZ=$$FILLFLDS^IBNCPUT1(356.8,.03,+IBNREC,0) I IBZZ'>0 D BMES^XPDUTL("     *** ERROR: "_$P(IBZZ,U,3))

SCREEN7 ;Recompile Screen 7 Input Template

 N DMAX,IBIEN,IBRTN,X,Y

 S DMAX=$$ROUSIZE^DILF

 D MES^XPDUTL("Recompiling Screen 7 input template ...")

 ;find the ien of the input template

 S IBIEN=$O(^DIE("B","IB SCREEN7",0)) Q:'IBIEN

 ;quit if input template not compiled

 S IBRTN=$P($G(^DIE(IBIEN,"ROUOLD")),U) Q:IBRTN=""

 D MES^XPDUTL("Compiling IB SCREEN7, compiled routine is "_IBRTN_" ...")

 S X=IBRTN,Y=IBIEN

 D EN^DIEZ

 D MES^XPDUTL("Completed compiling input template.")

 D MES^XPDUTL("")

NEWR ; Add new RNBs (if RNB already exists ensure Code is set)

 N IBI,IBJ,IBLN,IBNM,IBRNB,IBTOT,IBTNC,IBTCH,DIC,DR,DO,X,Y,DLAYGO,DINUM,IBA

 S (IBTOT,IBTNC,IBTCH)=0 S DLAYGO=356.8

 D MSG("    Add 1 New Reason Not Billable (#356.8)...")

 F IBI=1:1 S IBLN=$P($T(NEW+IBI),";;",2,999) Q:'IBLN  D

 . S IBNM=$P(IBLN,U,6) S IBRNB=$O(^IBE(356.8,"B",IBNM,0))

 . I IBRNB Q

. ;

 . F IBJ=61:1 I '$D(^IBE(356.8,IBJ,0)),IBJ'=72,IBJ'=90 Q

. ;

 . S IBTOT=IBTOT+1

. ;

 . S DIC("DR")=".02////"_$P(IBLN,U,4)_";.03////"_$P(IBLN,U,5)

 . S DIC="^IBE(356.8,",DIC(0)="L",X=IBNM,DINUM=IBJ D FILE^DICN K DIC I 'Y D MSG(IBNM_" Not Added, ERROR ****") Q

 . S IBTCH=IBTCH+1 D MSG("    - "_IBNM_" added")

 I 'IBTCH D MSG("    No Change: "_IBTNC_" of "_IBTOT_" New RNBs Already Exist")

 I +IBTCH D MSG("    Updated: "_IBTCH_" of "_IBTOT_" New RNBs Added")

 D MES^XPDUTL(.IBA)

 ; RNB'S to add to CT RNB file

NEW ;;

 ;;61^NEW^CV15^1^0^NO PHARMACY COVERAGE

;;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P384   6214     printed  Apr 23, 2025@18:16:58                                                                                                                                                                                                    Page 2

IB20P384  ;ALB/BDB - IB*2.0*384 POST INIT: ADD REASON NOT BILLABLE ;08-NOV-2007

 +1       ;;2.0;INTEGRATED BILLING;**384**;21-MAR-94;Build 74

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4        QUIT

 +5       ;

POST      ;

 +1        NEW IBA

 +2        SET IBA(1)=""

           SET IBA(2)="    IB*2*384 Post-Install ....."

           SET IBA(3)=""

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +3       ; Recompile the Screen 7 input template

           DO SCREEN7

 +4       ; Edit SCEI's to be ECME selectable in Claims Tracking Non-Billable Reasons file(#356.8)

           DO SCEIEDIT

 +5       ; New IB328 'ROI form required for sensitive record' IB Error file (#350.8)

           DO IBERRAD

 +6       ;populate new #350.9 field #11.02 and add one record with reject code=70 to the subfile #350.912

 +7       ;for NON-COVERED DRUGS functionality; add new non-billable reason "NON COVERED DRUG PER PLAN"

 +8        DO NONCOVDR

 +9       ; add new RNB to CT RNB file (#356.8)

           DO NEWR

 +10       SET IBA(1)=""

           SET IBA(2)="    IB*2*384 Post-Install Complete"

           SET IBA(3)=""

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +11       QUIT

 +12      ;

SCEIEDIT  ; Edit SCEI's to be ECME selectable in Claims Tracking Non-Billable Reasons file(#356.8)

 +1        NEW DD,DO,DLAYGO,DINUM,DIC,DIE,DA,DR,X,Y,IBA,IBFOUND,IBFOUND1,IBATFN,IBNUM,IBAT,IBFN,IBIEN

 +2        SET IBA(1)=""

           SET IBA(2)="      >> Editing Service Connected/Environmental Indicators to be ECME"

 +3        SET IBA(3)="      >> selectable in the Claims Tracking Non-Billable Reasons file (#356.8)"

 +4        SET IBFOUND1=""

 +5        FOR IBNUM=1:1:8

               SET IBIEN=$ORDER(^IBE(356.8,"B",$PIECE("SC TREATMENT^AGENT ORANGE^IONIZING RADIATION^SOUTHWEST ASIA^MILITARY SEXUAL TRAUMA^HEAD/NECK CANCER^COMBAT VETERAN^PROJECT 112/SHAD",U,IBNUM),""))

               Begin DoDot:1

 +6                SET IBFOUND=""

                   IF +IBIEN

                       SET IBFOUND=$GET(^IBE(356.8,IBIEN,0))

 +7                IF IBFOUND=""

                       SET IBFOUND1=1

                       DO MSG(" ")

                       DO MSG("     *** ERROR: Entry "_$PIECE("SC^AO^IR^SWA^MST^HNC^CV^SHAD",U,IBNUM)_" missing, could not edit")

                       QUIT

 +8                SET DR=".02////1;.03////0"

 +9                SET DIE="^IBE(356.8,"

                   SET DA=IBIEN

                   DO ^DIE

                   KILL DIE,DA,DR,X,Y

               End DoDot:1

 +10       if IBFOUND1=""

               DO MSG("         Done. Service Connected/Environmental Indicators edited")

 +11       if '(IBFOUND1="")

               DO MSG("     *** ERROR: One or more entries could not be edited")

SCEIQ      DO MES^XPDUTL(.IBA)

           KILL IBA

 +1        QUIT

 +2       ;

IBERRAD   ; New IB328 'ROI form required for sensitive record' IB Error file (#350.8)

 +1        NEW DD,DO,DINUM,DIC,DIE,DA,DR,X,Y,IBA,IBFOUND,IBATFN,IBAT,IBIEN

 +2        SET IBA(1)="      >> Adding IB328 'ROI form required for sensitive record'"

 +3        SET IBA(2)="      >> in the IB Error file (#350.8)"

 +4        SET IBAT="IB328"

           SET IBIEN=$GET(^IBE(350.8,"AC",IBAT))

 +5        SET IBFOUND=""

           IF +IBIEN

               SET IBFOUND=$GET(^IBE(350.8,IBIEN,0))

 +6        IF IBFOUND="IB328^ROI form required for sensitive record^IB328^1^3"

               DO MSG("         Done. IB328 'ROI form required for sensitive record' already exists")

               GOTO IBERRADQ

 +7        IF IBFOUND'=""

               DO MSG(" ")

               DO MSG("     *** ERROR: Entry already exists, could not add")

               GOTO IBERRADQ

 +8        KILL DD,DO

           SET DIC="^IBE(350.8,"

           SET DIC(0)="L"

           SET X=IBAT

           DO FILE^DICN

           KILL DIC

           SET IBIEN=+Y

 +9        IF Y<1

               KILL X,Y

               DO MSG(" ")

               DO MSG("     *** ERROR: New entry could not be added")

               GOTO IBERRADQ

 +10       SET DR=".02////ROI form required for sensitive record;.03////IB328;.04////1;.05////3"

 +11       SET DIE="^IBE(350.8,"

           SET DA=+IBIEN

           DO ^DIE

           KILL DIE,DA,DR,X,Y

 +12       DO MSG("         Done. IB328 'ROI form required for sensitive record'  added")

IBERRADQ   DO MES^XPDUTL(.IBA)

           KILL IBA

 +1        QUIT

 +2       ;

MSG(X)    ;

 +1        NEW IBX

           SET IBX=$ORDER(IBA(999999),-1)

           if 'IBX

               SET IBX=1

           SET IBX=IBX+1

 +2        SET IBA(IBX)=$GET(X)

 +3        QUIT

 +4       ;

 +5       ;populate fields for NON-COVERED DRUGS functionality

NONCOVDR  ;

 +1        IF $PIECE($GET(^IBE(350.9,1,11)),U,2)>0

               Begin DoDot:1

 +2                DO BMES^XPDUTL("      >>   Skipping: NON-COVERED DRUGS functionality has been already activated")

               End DoDot:1

               QUIT

 +3        NEW IBZZ,IBNREC

 +4        DO BMES^XPDUTL("      >> Populating new #350.9 fields for NON-COVERED DRUGS functionality")

 +5        DO BMES^XPDUTL("      >>   turning off the NON-COVERED DRUGS functionality by default")

 +6        SET IBZZ=$$FILLFLDS^IBNCPUT1(350.9,11.02,1,0)

 +7        IF IBZZ'>0

               DO BMES^XPDUTL("     *** ERROR: "_$PIECE(IBZZ,U,3))

 +8        IF '$ORDER(^IBE(350.9,1,12,"B","70",0))

               Begin DoDot:1

 +9                DO BMES^XPDUTL("      >>   adding '70 Product/Service Not Covered' as default reject code")

 +10               IF $$INSITEM^IBNCPUT1(350.912,1,"70","","E")'>0

                       DO BMES^XPDUTL("     *** ERROR: could not add")

               End DoDot:1

 +11      ;add a new non-billable reason "NON COVERED DRUG PER PLAN"

 +12      ;to the file (#356.8) CLAIMS TRACKING NON-BILLABLE REASONS file

 +13       IF '$ORDER(^IBE(356.8,"B","NON COVERED DRUG PER PLAN",0))

               Begin DoDot:1

 +14               DO BMES^XPDUTL("      >>   adding a new 'NON COVERED DRUG PER PLAN' non-billable reason to the file #356.8")

 +15               SET IBNREC=$$INSITEM^IBNCPUT1(356.8,"","NON COVERED DRUG PER PLAN","","E")

                   IF IBZZ'>0

                       DO BMES^XPDUTL("     *** ERROR: could not add")

                       QUIT

 +16               DO BMES^XPDUTL("      >>   setting the ECME FLAG to 'Yes'")

 +17               SET IBZZ=$$FILLFLDS^IBNCPUT1(356.8,.02,+IBNREC,1)

                   IF IBZZ'>0

                       DO BMES^XPDUTL("     *** ERROR: "_$PIECE(IBZZ,U,3))

 +18               DO BMES^XPDUTL("      >>   setting the ECME PAPER FLAG to 'No'")

 +19               SET IBZZ=$$FILLFLDS^IBNCPUT1(356.8,.03,+IBNREC,0)

                   IF IBZZ'>0

                       DO BMES^XPDUTL("     *** ERROR: "_$PIECE(IBZZ,U,3))

               End DoDot:1

 +20       QUIT

 +21      ;

SCREEN7   ;Recompile Screen 7 Input Template

 +1        NEW DMAX,IBIEN,IBRTN,X,Y

 +2        SET DMAX=$$ROUSIZE^DILF

 +3        DO MES^XPDUTL("Recompiling Screen 7 input template ...")

 +4       ;

 +5       ;find the ien of the input template

 +6        SET IBIEN=$ORDER(^DIE("B","IB SCREEN7",0))

           if 'IBIEN

               QUIT

 +7       ;

 +8       ;quit if input template not compiled

 +9        SET IBRTN=$PIECE($GET(^DIE(IBIEN,"ROUOLD")),U)

           if IBRTN=""

               QUIT

 +10      ;

 +11       DO MES^XPDUTL("Compiling IB SCREEN7, compiled routine is "_IBRTN_" ...")

 +12       SET X=IBRTN

           SET Y=IBIEN

 +13       DO EN^DIEZ

 +14       DO MES^XPDUTL("Completed compiling input template.")

 +15       DO MES^XPDUTL("")

 +16       QUIT

 +17      ;

NEWR      ; Add new RNBs (if RNB already exists ensure Code is set)

 +1        NEW IBI,IBJ,IBLN,IBNM,IBRNB,IBTOT,IBTNC,IBTCH,DIC,DR,DO,X,Y,DLAYGO,DINUM,IBA

 +2        SET (IBTOT,IBTNC,IBTCH)=0

           SET DLAYGO=356.8

 +3       ;

 +4        DO MSG("    Add 1 New Reason Not Billable (#356.8)...")

 +5       ;

 +6        FOR IBI=1:1

               SET IBLN=$PIECE($TEXT(NEW+IBI),";;",2,999)

               if 'IBLN

                   QUIT

               Begin DoDot:1

 +7                SET IBNM=$PIECE(IBLN,U,6)

                   SET IBRNB=$ORDER(^IBE(356.8,"B",IBNM,0))

 +8                IF IBRNB

                       QUIT

 +9       ;

 +10               FOR IBJ=61:1

                       IF '$DATA(^IBE(356.8,IBJ,0))

                           IF IBJ'=72

                               IF IBJ'=90

                                   QUIT

 +11      ;

 +12               SET IBTOT=IBTOT+1

 +13      ;

 +14               SET DIC("DR")=".02////"_$PIECE(IBLN,U,4)_";.03////"_$PIECE(IBLN,U,5)

 +15               SET DIC="^IBE(356.8,"

                   SET DIC(0)="L"

                   SET X=IBNM

                   SET DINUM=IBJ

                   DO FILE^DICN

                   KILL DIC

                   IF 'Y

                       DO MSG(IBNM_" Not Added, ERROR ****")

                       QUIT

 +16               SET IBTCH=IBTCH+1

                   DO MSG("    - "_IBNM_" added")

               End DoDot:1

 +17      ;

 +18       IF 'IBTCH

               DO MSG("    No Change: "_IBTNC_" of "_IBTOT_" New RNBs Already Exist")

 +19       IF +IBTCH

               DO MSG("    Updated: "_IBTCH_" of "_IBTOT_" New RNBs Added")

 +20      ;

 +21       DO MES^XPDUTL(.IBA)

 +22      ;

 +23       QUIT

 +24      ;

 +25      ; RNB'S to add to CT RNB file

NEW       ;;

 +1       ;;61^NEW^CV15^1^0^NO PHARMACY COVERAGE

 +2       ;;

 +3        QUIT

IB20P384.m