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