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 Apr 09, 2024@21:15:03 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 ;
