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 ---[H[J[2J[HIBY516PR 3720 printed Dec 13, 2024@02:34:22 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 ;
