IBY403PR ;BP/YMG - Pre-Installation for IB patch 403 ;26-Aug-2008
;;2.0;INTEGRATED BILLING;**403**;21-MAR-94;Build 24
;;Per VHA Directive 2004-038, this routine should not be modified.
;
D DELOF ; delete all output formatter data elements included in build
D DEFDIV ; check default division
Q
;
DELOF ; Delete included output formatter entries
NEW FILE,DIK,LN,TAG,DATA,PCE,DA,Y
F FILE=5,6,7 S DIK="^IBA(364."_FILE_"," F LN=2:1 S TAG="ENT"_FILE_"+"_LN,DATA=$P($T(@TAG),";;",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
;
; Also delete output formatter entries which are not going to be
; re-added later. These are non-functioning or obsolete entries
; in file 364.6.
S DIK="^IBA(364.6,",TAG="DEL6+2",DATA=$P($T(@TAG),";;",2)
I DATA'="" D
. F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA I $D(^IBA(364.6,DA,0)) D ^DIK
. Q
;
; Also delete output formatter entries which are not going to be
; re-added later. These are non-functioning or obsolete entries
; in file 364.7.
S DIK="^IBA(364.7,",TAG="DEL7+2",DATA=$P($T(@TAG),";;",2)
I DATA'="" D
. F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA I $D(^IBA(364.7,DA,0)) D ^DIK
. Q
;
DELOFX ;
Q
;
DEFDIV ; check and report on default division (350.9,1.25)
N DEF,MAIN,DEFDN,MAINDN,DEFINST,MAININST,SITE,SUBJ,MSG,XMTO
;
S DEF=+$P($G(^IBE(350.9,1,1)),U,25) ; default division field from the IB site params
S MAIN=+$$PRIM^VASITE() ; main division for VistA database
I 'DEF G DEFDIVX ; exit if no default division
I DEF=MAIN G DEFDIVX ; exit if they're the same
I '$$PROD^XUPROD(1) G DEFDIVX ; not a production account
;
; default division is different than main division - report on both
S DEFDN=$$GET1^DIQ(40.8,DEF_",",.01) ; default division name
S MAINDN=$$GET1^DIQ(40.8,MAIN_",",.01) ; main division name
;
S DEFINST=$$SITE^VASITE($$DT^XLFDT,DEF) ; default institution information
S MAININST=$$SITE^VASITE($$DT^XLFDT,MAIN) ; main institution information
;
; send email
S SITE=$$SITE^VASITE
S SUBJ="Station# "_$P(SITE,U,3)_" - "_$P(SITE,U,2)_" - Default/Main Division"
S SUBJ=$E(SUBJ,1,65)
S MSG(1)="Default Division Name: "_DEFDN
S MSG(2)=" Inst Name: "_$P(DEFINST,U,2)
S MSG(3)=" Station#: "_$P(DEFINST,U,3)
S MSG(4)=""
S MSG(5)=" Main Division Name: "_MAINDN
S MSG(6)=" Inst Name: "_$P(MAININST,U,2)
S MSG(7)=" Station#: "_$P(MAININST,U,3)
;
S XMTO("Eric.Gustafson@domain.ext")=""
;
D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO)
;
DEFDIVX ;
Q
;
INCLUDE(FILE,Y) ; function to determine if output formatter 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
INCLUDEX ;
Q OK
;
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
;
;-----------------------------------------------------------------------
; 364.5 entries modified:
;
ENT5 ; output formatter entries in file 364.5 to be included
;
;;
;
;-----------------------------------------------------------------------
; 364.6 entries modified:
;
ENT6 ; output formatter entries in file 364.6 to be included
;
;;^93^952^1879^
;
;
;-----------------------------------------------------------------------
; 364.7 entries modified:
;
ENT7 ; output formatter entries in file 364.7 to be included
;
;;^27^41^84^924^1015^1298^1371^1383^1384^1385^1386^1387^1388^1389^1390^1391^1392^1393^
;;^1394^1395^1396^1397^1398^1399^1400^1411^1579^
;;
;
;
;-----------------------------------------------------------------------
DEL6 ; remove output formatter entries in file 364.6 (not re-added)
;
;;
;
;-----------------------------------------------------------------------
DEL7 ; remove output formatter entries in file 364.7 (not re-added)
;
;;
;
ENT3508 ; entries in file 350.8 to be included
;
;;^IB071^IB117^
;;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY403PR 4438 printed Nov 22, 2024@17:44:06 Page 2
IBY403PR ;BP/YMG - Pre-Installation for IB patch 403 ;26-Aug-2008
+1 ;;2.0;INTEGRATED BILLING;**403**;21-MAR-94;Build 24
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; delete all output formatter data elements included in build
DO DELOF
+5 ; check default division
DO DEFDIV
+6 QUIT
+7 ;
DELOF ; Delete included output formatter entries
+1 NEW FILE,DIK,LN,TAG,DATA,PCE,DA,Y
+2 FOR FILE=5,6,7
SET DIK="^IBA(364."_FILE_","
FOR LN=2:1
SET TAG="ENT"_FILE_"+"_LN
SET DATA=$PIECE($TEXT(@TAG),";;",2)
if DATA=""
QUIT
Begin DoDot:1
+3 FOR PCE=2:1
SET DA=$PIECE(DATA,U,PCE)
if 'DA
QUIT
IF $DATA(^IBA("364."_FILE,DA,0))
DO ^DIK
+4 QUIT
End DoDot:1
+5 ;
+6 ; Also delete output formatter entries which are not going to be
+7 ; re-added later. These are non-functioning or obsolete entries
+8 ; in file 364.6.
+9 SET DIK="^IBA(364.6,"
SET TAG="DEL6+2"
SET DATA=$PIECE($TEXT(@TAG),";;",2)
+10 IF DATA'=""
Begin DoDot:1
+11 FOR PCE=2:1
SET DA=$PIECE(DATA,U,PCE)
if 'DA
QUIT
IF $DATA(^IBA(364.6,DA,0))
DO ^DIK
+12 QUIT
End DoDot:1
+13 ;
+14 ; Also delete output formatter entries which are not going to be
+15 ; re-added later. These are non-functioning or obsolete entries
+16 ; in file 364.7.
+17 SET DIK="^IBA(364.7,"
SET TAG="DEL7+2"
SET DATA=$PIECE($TEXT(@TAG),";;",2)
+18 IF DATA'=""
Begin DoDot:1
+19 FOR PCE=2:1
SET DA=$PIECE(DATA,U,PCE)
if 'DA
QUIT
IF $DATA(^IBA(364.7,DA,0))
DO ^DIK
+20 QUIT
End DoDot:1
+21 ;
DELOFX ;
+1 QUIT
+2 ;
DEFDIV ; check and report on default division (350.9,1.25)
+1 NEW DEF,MAIN,DEFDN,MAINDN,DEFINST,MAININST,SITE,SUBJ,MSG,XMTO
+2 ;
+3 ; default division field from the IB site params
SET DEF=+$PIECE($GET(^IBE(350.9,1,1)),U,25)
+4 ; main division for VistA database
SET MAIN=+$$PRIM^VASITE()
+5 ; exit if no default division
IF 'DEF
GOTO DEFDIVX
+6 ; exit if they're the same
IF DEF=MAIN
GOTO DEFDIVX
+7 ; not a production account
IF '$$PROD^XUPROD(1)
GOTO DEFDIVX
+8 ;
+9 ; default division is different than main division - report on both
+10 ; default division name
SET DEFDN=$$GET1^DIQ(40.8,DEF_",",.01)
+11 ; main division name
SET MAINDN=$$GET1^DIQ(40.8,MAIN_",",.01)
+12 ;
+13 ; default institution information
SET DEFINST=$$SITE^VASITE($$DT^XLFDT,DEF)
+14 ; main institution information
SET MAININST=$$SITE^VASITE($$DT^XLFDT,MAIN)
+15 ;
+16 ; send email
+17 SET SITE=$$SITE^VASITE
+18 SET SUBJ="Station# "_$PIECE(SITE,U,3)_" - "_$PIECE(SITE,U,2)_" - Default/Main Division"
+19 SET SUBJ=$EXTRACT(SUBJ,1,65)
+20 SET MSG(1)="Default Division Name: "_DEFDN
+21 SET MSG(2)=" Inst Name: "_$PIECE(DEFINST,U,2)
+22 SET MSG(3)=" Station#: "_$PIECE(DEFINST,U,3)
+23 SET MSG(4)=""
+24 SET MSG(5)=" Main Division Name: "_MAINDN
+25 SET MSG(6)=" Inst Name: "_$PIECE(MAININST,U,2)
+26 SET MSG(7)=" Station#: "_$PIECE(MAININST,U,3)
+27 ;
+28 SET XMTO("Eric.Gustafson@domain.ext")=""
+29 ;
+30 DO SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO)
+31 ;
DEFDIVX ;
+1 QUIT
+2 ;
INCLUDE(FILE,Y) ; function to determine if output formatter entry should be
+1 ; included in the build
+2 ; FILE=5,6,7 indicating file 364.x
+3 ; Y=ien to file
+4 ;
+5 NEW OK,LN,TAG,DATA
+6 SET OK=0
+7 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
INCLUDEX ;
+1 QUIT OK
+2 ;
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 ;
+7 ;-----------------------------------------------------------------------
+8 ; 364.5 entries modified:
+9 ;
ENT5 ; output formatter entries in file 364.5 to be included
+1 ;
+2 ;;
+3 ;
+4 ;-----------------------------------------------------------------------
+5 ; 364.6 entries modified:
+6 ;
ENT6 ; output formatter entries in file 364.6 to be included
+1 ;
+2 ;;^93^952^1879^
+3 ;
+4 ;
+5 ;-----------------------------------------------------------------------
+6 ; 364.7 entries modified:
+7 ;
ENT7 ; output formatter entries in file 364.7 to be included
+1 ;
+2 ;;^27^41^84^924^1015^1298^1371^1383^1384^1385^1386^1387^1388^1389^1390^1391^1392^1393^
+3 ;;^1394^1395^1396^1397^1398^1399^1400^1411^1579^
+4 ;;
+5 ;
+6 ;
+7 ;-----------------------------------------------------------------------
DEL6 ; remove output formatter entries in file 364.6 (not re-added)
+1 ;
+2 ;;
+3 ;
+4 ;-----------------------------------------------------------------------
DEL7 ; remove output formatter entries in file 364.7 (not re-added)
+1 ;
+2 ;;
+3 ;
ENT3508 ; entries in file 350.8 to be included
+1 ;
+2 ;;^IB071^IB117^
+3 ;;
+4 ;
