- IBY577PR ;AITC/VD - Pre-Installation for IB patch 577 ;06-APR-2017
- ;;2.0;INTEGRATED BILLING;**577**;21-MAR-94;Build 38
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; delete all output formatter (O.F.) data elements included in build
- D DELOF
- 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
- ;
- ;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
- ;
- ;;
- ;
- ;-----------------------------------------------------------------------
- ; 364.6 entries modified:
- ;
- ; 170 - SUB-2
- ; 171 - SUB-3
- ; 956 - OI1A-9
- ; 957 - CI3A-4
- ; 970 - SUB2-13 (was SUB-8)
- ; 1930 - PRV1-7
- ; 1931 - PRV1-8
- ; 1940 - AMB-3
- ; 1941 - AMB-4
- ; 1968 - CI3A-9
- ; 1975 - PT2-6
- ; 2025 - OI4-12
- ; 2371 - SUB-8
- ;
- ENT6 ; O.F. entries in file 364.6 to be included
- ;
- ;;^170^171^956^957^970^1930^1931^1940^1941^1968^1975^2025^2371^
- ;
- ;-----------------------------------------------------------------------
- ; 364.7 entries modified:
- ;
- ; 804 - COB1-2
- ; 939 - PRF-23
- ; 941 - PRF-25
- ; 1015 - GEN-7
- ; 1406 - INS-15
- ; 1537 - OI6-7
- ; 1538 - OI6-8
- ; 1551 - OI6-10.1
- ; 1927 - COB1-7
- ; 1949 - INS-16
- ; 1950 - INS-17
- ; 1955 - OI1A-2
- ; 1956 - SUB-8
- ;
- ENT7 ; O.F. entries in file 364.7 to be included
- ;
- ;;^804^939^941^1015^1406^1537^1538^1551^1927^1949^1950^1955^1956^
- ;
- ;-----------------------------------------------------------------------
- ; 364.5 entries deleted:
- ;
- DEL5 ; remove O.F. entries in file 364.5 (not re-added)
- ;
- ;;
- ;
- ;-----------------------------------------------------------------------
- ; 364.6 entries deleted:
- ;
- ; 1850 - OI6-6.9
- ;
- DEL6 ; remove O.F. entries in file 364.6 (not re-added)
- ;
- ;;^1850^
- ;
- ;-----------------------------------------------------------------------
- ; 364.7 entries deleted:
- ;
- ; 1550 - OI6-6.9
- ;
- DEL7 ; remove O.F. entries in file 364.7 (not re-added)
- ;
- ;;^1550^
- ;
- ;-----------------------------------------------------------------------
- ENT3508 ; Add New IB Error Codes to File 350.8
- ;
- ;;^IB365^
- ;
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY577PR 3281 printed Mar 13, 2025@21:39:48 Page 2
- IBY577PR ;AITC/VD - Pre-Installation for IB patch 577 ;06-APR-2017
- +1 ;;2.0;INTEGRATED BILLING;**577**;21-MAR-94;Build 38
- +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
- +6 QUIT
- +7 ;
- 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 ;
- +8 ;Delete edited entries to insure clean install of new entries
- +9 ;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 ;-----------------------------------------------------------------------
- +13 ; 364.5 entries modified:
- +14 ;
- ENT5 ; OF entries in file 364.5 to be included
- +1 ;
- +2 ;;
- +3 ;
- +4 ;-----------------------------------------------------------------------
- +5 ; 364.6 entries modified:
- +6 ;
- +7 ; 170 - SUB-2
- +8 ; 171 - SUB-3
- +9 ; 956 - OI1A-9
- +10 ; 957 - CI3A-4
- +11 ; 970 - SUB2-13 (was SUB-8)
- +12 ; 1930 - PRV1-7
- +13 ; 1931 - PRV1-8
- +14 ; 1940 - AMB-3
- +15 ; 1941 - AMB-4
- +16 ; 1968 - CI3A-9
- +17 ; 1975 - PT2-6
- +18 ; 2025 - OI4-12
- +19 ; 2371 - SUB-8
- +20 ;
- ENT6 ; O.F. entries in file 364.6 to be included
- +1 ;
- +2 ;;^170^171^956^957^970^1930^1931^1940^1941^1968^1975^2025^2371^
- +3 ;
- +4 ;-----------------------------------------------------------------------
- +5 ; 364.7 entries modified:
- +6 ;
- +7 ; 804 - COB1-2
- +8 ; 939 - PRF-23
- +9 ; 941 - PRF-25
- +10 ; 1015 - GEN-7
- +11 ; 1406 - INS-15
- +12 ; 1537 - OI6-7
- +13 ; 1538 - OI6-8
- +14 ; 1551 - OI6-10.1
- +15 ; 1927 - COB1-7
- +16 ; 1949 - INS-16
- +17 ; 1950 - INS-17
- +18 ; 1955 - OI1A-2
- +19 ; 1956 - SUB-8
- +20 ;
- ENT7 ; O.F. entries in file 364.7 to be included
- +1 ;
- +2 ;;^804^939^941^1015^1406^1537^1538^1551^1927^1949^1950^1955^1956^
- +3 ;
- +4 ;-----------------------------------------------------------------------
- +5 ; 364.5 entries deleted:
- +6 ;
- DEL5 ; remove O.F. entries in file 364.5 (not re-added)
- +1 ;
- +2 ;;
- +3 ;
- +4 ;-----------------------------------------------------------------------
- +5 ; 364.6 entries deleted:
- +6 ;
- +7 ; 1850 - OI6-6.9
- +8 ;
- DEL6 ; remove O.F. entries in file 364.6 (not re-added)
- +1 ;
- +2 ;;^1850^
- +3 ;
- +4 ;-----------------------------------------------------------------------
- +5 ; 364.7 entries deleted:
- +6 ;
- +7 ; 1550 - OI6-6.9
- +8 ;
- DEL7 ; remove O.F. entries in file 364.7 (not re-added)
- +1 ;
- +2 ;;^1550^
- +3 ;
- +4 ;-----------------------------------------------------------------------
- ENT3508 ; Add New IB Error Codes to File 350.8
- +1 ;
- +2 ;;^IB365^
- +3 ;
- +4 QUIT
- +5 ;
