Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBY403PR

IBY403PR.m

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