IBY770PR ;EDE/WCJ - Pre-Installation for IB patch 770 ; 10/12/17 2:12 pm
;;2.0;INTEGRATED BILLING;**770**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; entry point
;
N IBA
S IBA(2)="IB*2*770 Pre-Install...",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
;
D FIXIT
;
D CLEANUP364P99
;
; delete all output formatter (O.F.) data elements included in build
D DELOF
;
S IBA(2)="IB*2*770 Pre-Install Complete.",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
Q
;
FIXIT ;
D MES^XPDUTL("Updating file 364.8 field .08 - Test flag now required")
N D0 S D0=0 F S D0=$O(^IBA(364.8,D0)) Q:'+D0 I $P($G(^IBA(364.8,D0,0)),U,8)="" S $P(^IBA(364.8,D0,0),U,8)=0
D MES^XPDUTL("Finished file 364.8 field .08 updates")
Q
;
CLEANUP364P99 ; replace the file. only impacts IOC.
;
Q:'$D(^IBA(364.99)) ; new file is coming with the patch so have it start clean
;
D MES^XPDUTL("Updating file 364.99 - out with the old")
N TMP
S TMP=$P($G(^IBA(364.99,0)),U,1,2)
K ^IBA(364.99)
S ^IBA(364.99,0)=TMP
D MES^XPDUTL("Done removing data file 364.99 so we can start fresh")
Q
;
INCLUDE(FILE,Y) ; function to determine if O.F. entry should be included in the build
; FILE=5,6,7 indicating file 364.x or FILE=8 indicating file 350.8 (IB ERROR)
; 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:1:8 S DIK=$S(FILE=8:"^IBE(350.",1:"^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 D
.... I FILE=8,$D(^IBE(350.8,DA,0)) D ^DIK
.... Q:FILE=8
.... I $D(^IBA("364."_FILE,DA,0)) D ^DIK
Q
;
; Example for ENT5, ENT6, ENT7, ENT8, DEL5, DEL6, DEL7, and DEL8:
;;^195^254^259^269^324^325^
; Note: Must have beginning and ending up-carat
;
;-----------------------------------------------------------------------
; 364.5 O.F. entries added:
;
;
ENT5 ;O.F. entries in file 364.5 to be added
;
;;
;
;-----------------------------------------------------------------------
; 364.6 O.F. entries added:
;
;
ENT6 ;O.F. entries in file 364.6 to be added
;
;
;;
;
;-----------------------------------------------------------------------
; 364.7 O.F. entries added:
;
;
ENT7 ; O.F. entries in file 364.7 to be added
;
;;^1949^1950^
;
;
;-----------------------------------------------------------------------
; 350.8 O.F. entries added:
;
;
ENT8 ;O.F. entries in file 350.8 to be added
;
;;
;
;
;
;-----------------------------------------------------------------------
; 364.5 entries deleted:
;
DEL5 ; remove O.F. entries in file 364.5 (not re-added)
;
;;
;
;-----------------------------------------------------------------------
; 364.6 entries deleted:
;
DEL6 ; remove O.F. entries in file 364.6 (not re-added)
;
;;
;
;-----------------------------------------------------------------------
; 364.7 entries deleted:
;
;
DEL7 ; remove O.F. entries in file 364.7 (not re-added)
;
;;
;
;-----------------------------------------------------------------------
; 350.8 Entries deleted:
;
;
DEL8 ; remove entries from 350.8 (IB ERROR)
;
;;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY770PR 3576 printed May 25, 2026@12:40:36 Page 2
IBY770PR ;EDE/WCJ - Pre-Installation for IB patch 770 ; 10/12/17 2:12 pm
+1 ;;2.0;INTEGRATED BILLING;**770**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; entry point
+1 ;
+2 NEW IBA
+3 SET IBA(2)="IB*2*770 Pre-Install..."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+4 ;
+5 DO FIXIT
+6 ;
+7 DO CLEANUP364P99
+8 ;
+9 ; delete all output formatter (O.F.) data elements included in build
+10 DO DELOF
+11 ;
+12 SET IBA(2)="IB*2*770 Pre-Install Complete."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+13 QUIT
+14 ;
FIXIT ;
+1 DO MES^XPDUTL("Updating file 364.8 field .08 - Test flag now required")
+2 NEW D0
SET D0=0
FOR
SET D0=$ORDER(^IBA(364.8,D0))
if '+D0
QUIT
IF $PIECE($GET(^IBA(364.8,D0,0)),U,8)=""
SET $PIECE(^IBA(364.8,D0,0),U,8)=0
+3 DO MES^XPDUTL("Finished file 364.8 field .08 updates")
+4 QUIT
+5 ;
CLEANUP364P99 ; replace the file. only impacts IOC.
+1 ;
+2 ; new file is coming with the patch so have it start clean
if '$DATA(^IBA(364.99))
QUIT
+3 ;
+4 DO MES^XPDUTL("Updating file 364.99 - out with the old")
+5 NEW TMP
+6 SET TMP=$PIECE($GET(^IBA(364.99,0)),U,1,2)
+7 KILL ^IBA(364.99)
+8 SET ^IBA(364.99,0)=TMP
+9 DO MES^XPDUTL("Done removing data file 364.99 so we can start fresh")
+10 QUIT
+11 ;
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 or FILE=8 indicating file 350.8 (IB ERROR)
+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:1:8
SET DIK=$SELECT(FILE=8:"^IBE(350.",1:"^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
Begin DoDot:4
+6 IF FILE=8
IF $DATA(^IBE(350.8,DA,0))
DO ^DIK
+7 if FILE=8
QUIT
+8 IF $DATA(^IBA("364."_FILE,DA,0))
DO ^DIK
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
+11 ; Example for ENT5, ENT6, ENT7, ENT8, DEL5, DEL6, DEL7, and DEL8:
+12 ;;^195^254^259^269^324^325^
+13 ; Note: Must have beginning and ending up-carat
+14 ;
+15 ;-----------------------------------------------------------------------
+16 ; 364.5 O.F. entries added:
+17 ;
+18 ;
ENT5 ;O.F. entries in file 364.5 to be added
+1 ;
+2 ;;
+3 ;
+4 ;-----------------------------------------------------------------------
+5 ; 364.6 O.F. entries added:
+6 ;
+7 ;
ENT6 ;O.F. entries in file 364.6 to be added
+1 ;
+2 ;
+3 ;;
+4 ;
+5 ;-----------------------------------------------------------------------
+6 ; 364.7 O.F. entries added:
+7 ;
+8 ;
ENT7 ; O.F. entries in file 364.7 to be added
+1 ;
+2 ;;^1949^1950^
+3 ;
+4 ;
+5 ;-----------------------------------------------------------------------
+6 ; 350.8 O.F. entries added:
+7 ;
+8 ;
ENT8 ;O.F. entries in file 350.8 to be added
+1 ;
+2 ;;
+3 ;
+4 ;
+5 ;
+6 ;-----------------------------------------------------------------------
+7 ; 364.5 entries deleted:
+8 ;
DEL5 ; remove O.F. entries in file 364.5 (not re-added)
+1 ;
+2 ;;
+3 ;
+4 ;-----------------------------------------------------------------------
+5 ; 364.6 entries deleted:
+6 ;
DEL6 ; remove O.F. entries in file 364.6 (not re-added)
+1 ;
+2 ;;
+3 ;
+4 ;-----------------------------------------------------------------------
+5 ; 364.7 entries deleted:
+6 ;
+7 ;
DEL7 ; remove O.F. entries in file 364.7 (not re-added)
+1 ;
+2 ;;
+3 ;
+4 ;-----------------------------------------------------------------------
+5 ; 350.8 Entries deleted:
+6 ;
+7 ;
DEL8 ; remove entries from 350.8 (IB ERROR)
+1 ;
+2 ;;
+3 ;
