IBY516PR.m

IBY516PR ;ALB/WCJ - Pre-Installation for IB patch 516 ;4/14/14

 ;;2.0;INTEGRATED BILLING;**516**;21-MAR-94;Build 123

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 ; delete all output formatter (O.F.) data elements included in build

 D DELOF,RIT,DEL36,IBCLON

 Q

 ;

IBCLON ; Remove lock from IBCLON option - ICR#6126

 S DA=$$FIND1^DIC(19,,,"IB COPY AND CANCEL")

 I 'DA G IBCLONQ

 N IBFDA S IBFDA(19,DA_",",3)="@"

 D FILE^DIE("","IBFDA")

IBCLONQ ;

 Q

 ;

RIT ; recompile billing screen templates

 N X,Y,DMAX,IBN

 D MES^XPDUTL("Recompiling Input Templates for Billing Screens ...")

 F IBN=1:1:8,"10","102","10H" D

 .S X="IBXS"_$S(IBN=10:"A",IBN="102":"A2",IBN="10H":"AH",1:IBN),Y=$$FIND1^DIC(.402,,"X","IB SCREEN"_IBN,"B"),DMAX=$$ROUSIZE^DILF

 .I Y D EN^DIEZ

 D MES^XPDUTL(" Done.")

 Q

 ;

INC3508(Y) ; function to determine if entry in IB ERROR file (350.8) should be included in the build

 ; Y - ien to file

 N DATA,ENTRY,LN,OK,TAG

 S OK=0,ENTRY=U_$P($G(^IBE(350.8,Y,0)),U,3)_U

 F LN=2:1 S TAG="ENT3508+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA=""  I $F(DATA,ENTRY) S OK=1 Q

 Q OK

 ;

INCLUDE(FILE,Y) ; function to determine if O.F. entry should be included in the build

 ; FILE=5,6,7 indicating file 364.x

 ; Y=ien to file

 NEW OK,LN,TAG,DATA

 S OK=0

 F LN=2:1 S TAG="ENT"_FILE_"+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA=""  I $F(DATA,U_Y_U) S OK=1 Q

 Q OK

 ;

DEL36 ; This procedure deletes any data from four fields in file #36, Insurance Company.

 ;

 N DA,DIE,DR,IBDATA,IBFIELD,IBINSIEN

 S IBINSIEN=0

 F  S IBINSIEN=$O(^DIC(36,IBINSIEN)) Q:'IBINSIEN  D

 . F IBFIELD=4.07,4.11,4.12,4.13 D

 . . S IBDATA=$$GET1^DIQ(36,IBINSIEN_",",IBFIELD,"I")

 . . I IBDATA'="" D

 . . . S DIE="^DIC(36,"

 . . . S DA=IBINSIEN

 . . . S DR=IBFIELD_"///@"

 . . . D ^DIE

 . . . Q

 . . Q

 . Q

 Q

 ;

 ;Delete edited entries to insure clean install of new entries

 ;Delete obsolete entries.

DELOF   ; Delete included OF entries

 NEW FILE,DIK,LN,TAG,TAGLN,DATA,PCE,DA,Y

 F FILE=5,6,7 S DIK="^IBA(364."_FILE_"," D

 . F TAG="ENT"_FILE,"DEL"_FILE D

 .. F LN=2:1 S TAGLN=TAG_"+"_LN,DATA=$P($T(@TAGLN),";;",2) Q:DATA=""  D

 ... F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA  I $D(^IBA("364."_FILE,DA,0)) D ^DIK

 Q

 ;

 ; Example for ENT5, ENT6, ENT7, DEL5, DEL6, and DEL7:

 ;;^195^254^259^269^324^325^

 ; Note:  Must have beginning and ending up-carat

 ;

 ; 364.5 entries modified:

ENT5 ; OF entries in file 364.5 to be included

 ;

 ;;^199^200^

 ;

 ;-----------------------------------------------------------------------

 ; 364.6 entries modified:

 ;

ENT6 ; O.F. entries in file 364.6 to be included

 ;

 ;;^66^127^132^483^810^811^812^958^964^974^975^977^979^

 ;;^1014^1029^1030^1031^1034^1043^

 ;;^1839^1840^1851^

 ;;^2059^2060^

 ;;^2231^2235^2236^2237^2251^2252^

 ;

 ;-----------------------------------------------------------------------

ENT7 ; O.F. entries in file 364.7 to be included

 ;

 ;;^37^69^88^89^110^179^184^192^205^206^207^475^

 ;;^829^840^842^933^939^941^952^953^956^

 ;;^1015^1539^1540^1615^1674^1675^1759^1760^

 ;;^1945^1946^1947^1948^1949^1950^

 ;

 ;-----------------------------------------------------------------------

DEL5    ; remove O.F. entries in file 364.5 (not re-added)

 ;

 ;;

 ;

 ;-----------------------------------------------------------------------

DEL6    ; remove O.F. entries in file 364.6 (not re-added)

 ;

 ;;^1826^1827^

 ;

 ;-----------------------------------------------------------------------

DEL7    ; remove O.F. entries in file 364.7 (not re-added)

 ;

 ;;

 ;

 ;-----------------------------------------------------------------------

ENT3508 ; Add New IB Error Codes to File 350.8

 ;

 ;;

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBY516PR   3720     printed  Mar 13, 2025@21:39:32                                                                                                                                                                                                    Page 2

IBY516PR  ;ALB/WCJ - Pre-Installation for IB patch 516 ;4/14/14

 +1       ;;2.0;INTEGRATED BILLING;**516**;21-MAR-94;Build 123

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; delete all output formatter (O.F.) data elements included in build

 +5        DO DELOF

           DO RIT

           DO DEL36

           DO IBCLON

 +6        QUIT 

 +7       ;

IBCLON    ; Remove lock from IBCLON option - ICR#6126

 +1        SET DA=$$FIND1^DIC(19,,,"IB COPY AND CANCEL")

 +2        IF 'DA

               GOTO IBCLONQ

 +3        NEW IBFDA

           SET IBFDA(19,DA_",",3)="@"

 +4        DO FILE^DIE("","IBFDA")

IBCLONQ   ;

 +1        QUIT 

 +2       ;

RIT       ; recompile billing screen templates

 +1        NEW X,Y,DMAX,IBN

 +2        DO MES^XPDUTL("Recompiling Input Templates for Billing Screens ...")

 +3        FOR IBN=1:1:8,"10","102","10H"

               Begin DoDot:1

 +4                SET X="IBXS"_$SELECT(IBN=10:"A",IBN="102":"A2",IBN="10H":"AH",1:IBN)

                   SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN"_IBN,"B")

                   SET DMAX=$$ROUSIZE^DILF

 +5                IF Y

                       DO EN^DIEZ

               End DoDot:1

 +6        DO MES^XPDUTL(" Done.")

 +7        QUIT 

 +8       ;

INC3508(Y) ; function to determine if entry in IB ERROR file (350.8) should be included in the build

 +1       ; Y - ien to file

 +2        NEW DATA,ENTRY,LN,OK,TAG

 +3        SET OK=0

           SET ENTRY=U_$PIECE($GET(^IBE(350.8,Y,0)),U,3)_U

 +4        FOR LN=2:1

               SET TAG="ENT3508+"_LN

               SET DATA=$PIECE($TEXT(@TAG),";;",2)

               if DATA=""

                   QUIT 

               IF $FIND(DATA,ENTRY)

                   SET OK=1

                   QUIT 

 +5        QUIT OK

 +6       ;

INCLUDE(FILE,Y) ; function to determine if O.F. entry should be included in the build

 +1       ; FILE=5,6,7 indicating file 364.x

 +2       ; Y=ien to file

 +3        NEW OK,LN,TAG,DATA

 +4        SET OK=0

 +5        FOR LN=2:1

               SET TAG="ENT"_FILE_"+"_LN

               SET DATA=$PIECE($TEXT(@TAG),";;",2)

               if DATA=""

                   QUIT 

               IF $FIND(DATA,U_Y_U)

                   SET OK=1

                   QUIT 

 +6        QUIT OK

 +7       ;

DEL36     ; This procedure deletes any data from four fields in file #36, Insurance Company.

 +1       ;

 +2        NEW DA,DIE,DR,IBDATA,IBFIELD,IBINSIEN

 +3        SET IBINSIEN=0

 +4        FOR 

               SET IBINSIEN=$ORDER(^DIC(36,IBINSIEN))

               if 'IBINSIEN

                   QUIT 

               Begin DoDot:1

 +5                FOR IBFIELD=4.07,4.11,4.12,4.13

                       Begin DoDot:2

 +6                        SET IBDATA=$$GET1^DIQ(36,IBINSIEN_",",IBFIELD,"I")

 +7                        IF IBDATA'=""

                               Begin DoDot:3

 +8                                SET DIE="^DIC(36,"

 +9                                SET DA=IBINSIEN

 +10                               SET DR=IBFIELD_"///@"

 +11                               DO ^DIE

 +12                               QUIT 

                               End DoDot:3

 +13                       QUIT 

                       End DoDot:2

 +14               QUIT 

               End DoDot:1

 +15       QUIT 

 +16      ;

 +17      ;Delete edited entries to insure clean install of new entries

 +18      ;Delete obsolete entries.

DELOF     ; Delete included OF entries

 +1        NEW FILE,DIK,LN,TAG,TAGLN,DATA,PCE,DA,Y

 +2        FOR FILE=5,6,7

               SET DIK="^IBA(364."_FILE_","

               Begin DoDot:1

 +3                FOR TAG="ENT"_FILE,"DEL"_FILE

                       Begin DoDot:2

 +4                        FOR LN=2:1

                               SET TAGLN=TAG_"+"_LN

                               SET DATA=$PIECE($TEXT(@TAGLN),";;",2)

                               if DATA=""

                                   QUIT 

                               Begin DoDot:3

 +5                                FOR PCE=2:1

                                       SET DA=$PIECE(DATA,U,PCE)

                                       if 'DA

                                           QUIT 

                                       IF $DATA(^IBA("364."_FILE,DA,0))

                                           DO ^DIK

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +6        QUIT 

 +7       ;

 +8       ; Example for ENT5, ENT6, ENT7, DEL5, DEL6, and DEL7:

 +9       ;;^195^254^259^269^324^325^

 +10      ; Note:  Must have beginning and ending up-carat

 +11      ;

 +12      ; 364.5 entries modified:

ENT5      ; OF entries in file 364.5 to be included

 +1       ;

 +2       ;;^199^200^

 +3       ;

 +4       ;-----------------------------------------------------------------------

 +5       ; 364.6 entries modified:

 +6       ;

ENT6      ; O.F. entries in file 364.6 to be included

 +1       ;

 +2       ;;^66^127^132^483^810^811^812^958^964^974^975^977^979^

 +3       ;;^1014^1029^1030^1031^1034^1043^

 +4       ;;^1839^1840^1851^

 +5       ;;^2059^2060^

 +6       ;;^2231^2235^2236^2237^2251^2252^

 +7       ;

 +8       ;-----------------------------------------------------------------------

ENT7      ; O.F. entries in file 364.7 to be included

 +1       ;

 +2       ;;^37^69^88^89^110^179^184^192^205^206^207^475^

 +3       ;;^829^840^842^933^939^941^952^953^956^

 +4       ;;^1015^1539^1540^1615^1674^1675^1759^1760^

 +5       ;;^1945^1946^1947^1948^1949^1950^

 +6       ;

 +7       ;-----------------------------------------------------------------------

DEL5      ; remove O.F. entries in file 364.5 (not re-added)

 +1       ;

 +2       ;;

 +3       ;

 +4       ;-----------------------------------------------------------------------

DEL6      ; remove O.F. entries in file 364.6 (not re-added)

 +1       ;

 +2       ;;^1826^1827^

 +3       ;

 +4       ;-----------------------------------------------------------------------

DEL7      ; remove O.F. entries in file 364.7 (not re-added)

 +1       ;

 +2       ;;

 +3       ;

 +4       ;-----------------------------------------------------------------------

ENT3508   ; Add New IB Error Codes to File 350.8

 +1       ;

 +2       ;;

 +3       ;