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

BIRESTD.m

Go to the documentation of this file. 
  1. BIRESTD ;IHS/CMI/MWR - CHECK AND RESTANDARDIZE VACCINE TABLE.; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  CHECK IMMUNIZATION (VACCINE) TABLE AGAINST HL7 STANDARD;
  1.  ;;  RESTANDARDIZE IF NECESSARY.
  1.  ;
  1.  ;----------
  1. CHKSTAND(BIERROR) ;EP
  1.  ;---> Check the Vaccine Table (IMMUNIZATION File #9999999.14)
  1.  ;---> against the HL7 Standard Table (BI IMMUNIZATION TABLE
  1.  ;---> HL7 STANDARD File #9002084.94), each entry, piece by piece.
  1.  ;---> If there is an error, return the Error Text and set ^BISITE(-1)
  1.  ;---> to act as a flag for other calls.
  1.  ;---> Parameters:
  1.  ;     1 - BIERROR (ret) BIERROR=Text.
  1.  ;
  1.  S BIERROR=""
  1.  ;
  1.  ;---> If Vaccine globals do not exist, return Error Text and quit.
  1.  I '$D(^AUTTIMM(0))!('$D(^BITN(0))) D  Q
  1.  .D ERRCD^BIUTL2(505,.BIERROR) S ^BISITE(-1)=""
  1.  ;
  1.  ;---> If there are any non-standard entries in the Vaccine Table,
  1.  ;---> return Error Text, set ^BISITE(-1), and quit.
  1.  N N S N=0
  1.  F  S N=$O(^AUTTIMM(N)) Q:'N  D  Q:BIERROR]""
  1.  .I '$D(^BITN(N,0)) D ERRCD^BIUTL2(508,.BIERROR)
  1.  I BIERROR]"" S ^BISITE(-1)="" Q
  1.  ;---> NOTE: If ^AUTTIMM(0) does not exist, set it ="IMMUNIZATION^9999999.14I"
  1.  ;--->       then restandardize.
  1.  ;--->       Likewise, ^BITN(0)="BI IMMUNIZATION TABLE HL7 STANDARD^9002084.94"
  1.  ;
  1.  ;---> Now check every Standard piece of the Vaccine Table.
  1.  ;---> If any Standard piece of data of a Vaccine is non-standard,
  1.  ;---> return Error Text, set ^BISITE(-1), and quit.
  1.  S N=0
  1.  F  S N=$O(^BITN(N)) Q:'N  D  Q:BIERROR]""
  1.  .I '$D(^AUTTIMM(N,0)) D ERRCD^BIUTL2(503,.BIERROR) Q
  1.  .;---> The following fields are copied below in COPYNEW, but are not checked
  1.  .;---> as part of the standard: 7-Active, 13-VIS Def, 16-Include in Forecast,
  1.  .;---> 18-Def Volume.
  1.  .N BIPC F BIPC=1,2,3,8,9,10,11,12,14,15,17,21:1:26 D
  1.  ..I $P(^AUTTIMM(N,0),U,BIPC)'=$P(^BITN(N,0),U,BIPC) D
  1.  ...D ERRCD^BIUTL2(503,.BIERROR)
  1.  I BIERROR]"" S ^BISITE(-1)="" Q
  1.  ;
  1.  ;---> Clear Non-standard flag.
  1.  K ^BISITE(-1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. RESTAND(BIERROR,BIPRMPT) ;EP
  1.  ;---> Restandardize the Vaccine Table (IMMUNIZATION File #9999999.14)
  1.  ;---> by copying from the HL7 Standard Table (BI IMMUNIZATION TABLE
  1.  ;---> HL7 STANDARD File #9002084.94).
  1.  ;---> Parameters:
  1.  ;     1 - BIERROR (ret) BIERROR=Text (Translation Table is corrupt).
  1.  ;     2 - BIPRMPT (opt) If BIPRMPT=1 report "Complete".
  1.  ;
  1.  S:'$G(BIPRMPT) BIPRMPT=""
  1.  S BIERROR=""
  1.  I '$D(^AUTTIMM(0))!('$D(^BITN(0))) D  Q
  1.  .D ERRCD^BIUTL2(505,.BIERROR,1)
  1.  ;
  1.  ;---> First, rebuild ^BITN global.
  1.  D ^BITN
  1.  ;
  1.  ;---> Remove any non-standard entries in the Vaccine Table.
  1.  N N S N=0
  1.  F  S N=$O(^AUTTIMM(N)) Q:'N  D
  1.  .I '$D(^BITN(N,0)) K ^AUTTIMM(N)
  1.  ;
  1.  ;---> Copy every HL7 Standard Table piece to the Vaccine Table.
  1.  D COPYNEW(.BIERROR)
  1.  ;
  1.  ;---> RestandardizE the Vaccine Manufacturer Table.
  1.  Q:BIERROR
  1.  W:BIPRMPT>0 !!?5,"Restandardization of Vaccine Table complete."
  1.  D RESTDMAN(.BIERROR)
  1.  Q:BIERROR  D:BIPRMPT>0
  1.  .W !?5,"Restandardization of Manufacturer Table complete."
  1.  .D DIRZ^BIUTL3()
  1.  ;
  1.  ;---> Clear Non-standard flag.
  1.  K ^BISITE(-1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. COPYNEW(BIPOP) ;EP
  1.  ;---> Copy New Standard to Vaccine Table (IMMUNIZATION File).
  1.  ;---> Parameters:
  1.  ;     1 - BIPOP (ret) BIPOP=1 if Translation Table is corrupt.
  1.  ;
  1.  S BIPOP=0
  1.  I '$O(^BITN(0)) D ERRCD^BIUTL2(505,,1) S BIPOP=1 Q
  1.  N BIN S BIN=0
  1.  F  S BIN=$O(^BITN(BIN)) Q:'BIN  Q:BIPOP  D
  1.  .I '$D(^BITN(BIN,0)) D ERRCD^BIUTL2(505,,1) S BIPOP=1 Q
  1.  .;
  1.  .;---> Copy HL7 Standard Table pieces to the Vaccine Table.
  1.  .;---> Imm v8.3: Remove .07 field, "ACTIVE"; (leave local site setting).  vvv83
  1.  .N BIPC F BIPC=1,2,3,8,9,10,11,12,13,14,15,16,17,18,21:1:26 D
  1.  ..S $P(^AUTTIMM(BIN,0),U,BIPC)=$P(^BITN(BIN,0),U,BIPC)
  1.  .;
  1.  .;---> Set Status, .07, if not already set (i.e., don't overwrite local settings).
  1.  .I $P(^AUTTIMM(BIN,0),U,7)="" S $P(^AUTTIMM(BIN,0),U,7)=$P(^BITN(BIN,0),U,7)
  1.  .;
  1.  .Q:'$D(^BITN(BIN,1))
  1.  .;---> Reset 1 node as well.  Include 1.15 - vvv83.
  1.  .F BIPC=1:1:15 S $P(^AUTTIMM(BIN,1),U,BIPC)=$P(^BITN(BIN,1),U,BIPC)
  1.  ;
  1.  ;---> Now re-index all indices on the file.
  1.  D REIND1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. REIND1 ;EP
  1.  ;---> Re-index IMMUNIZATION File, ^AUTTIMM(.
  1.  ;---> First, remove all previous Vaccine Table indices.
  1.  N BIN S BIN="A"
  1.  F  S BIN=$O(^AUTTIMM(BIN)) Q:BIN=""  K @("^AUTTIMM("""_BIN_""")")
  1.  ;
  1.  ;---> Now re-index table.
  1.  S BIN=0
  1.  F  S BIN=$O(^AUTTIMM(BIN)) Q:'BIN  D
  1.  .N DA,DIK S DA=BIN,DIK="^AUTTIMM("
  1.  .D IX1^DIK
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. RESTDMAN(BIPOP) ;EP
  1.  ;---> Standardardize 100+ Entries in Manufacturer Table, ^AUTTIMAN.
  1.  ;---> Parameters:
  1.  ;     1 - BIPOP (ret) BIPOP=1 Error.
  1.  ;
  1.  S ^AUTTIMAN(0)="IMM MANUFACTURER^9999999.04I"
  1.  N N S N=99
  1.  F  S N=$O(^BIMAN(N)) Q:'N  D
  1.  .S ^AUTTIMAN(N,0)=^BIMAN(N,0)
  1.  D REIND2
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. REIND2 ;EP
  1.  ;---> Re-index IMM MANUFACTURER File, ^AUTTIMAN(.
  1.  ;---> First, remove all previous indices.
  1.  N BIN S BIN="A"
  1.  F  S BIN=$O(^AUTTIMAN(BIN)) Q:BIN=""  K @("^AUTTIMAN("""_BIN_""")")
  1.  ;
  1.  ;---> Now re-index table.
  1.  S BIN=0
  1.  F  S BIN=$O(^AUTTIMAN(BIN)) Q:'BIN  D
  1.  .N DA,DIK S DA=BIN,DIK="^AUTTIMAN("
  1.  .D IX1^DIK
  1.  Q