HLUPDATE ; IHS/TUC/DLR - UPDATE HL FILE ENTRIES ; [ 04/02/2003 8:36 AM ]
;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
;
; This routine updates the HL package file entries
; to support the current version of the HL7 standard.
; It is run from the M prompt, after HLINIT. It takes
; no input variables and produces no output variables.
;
N %,DA,DIC,GBL,I,V,VER,VSET,X,Y
D ^XBKVAR
;
W !,"Creating New HL7 Message Definitions.",!
;
S X="VXU",DIC="^HL(771.2,",DIC(0)="L",DLAYGO=771.2
S DIC("DR")="2///Unsolicited Vaccination Record Update"
D DEFINE I Y<0 D ABTMSG Q
;
S X="V04",DIC="^HL(779.001,",DIC(0)="L",DLAYGO=779.001
S DIC("DR")="2///Unsolicited Vaccination Record Update"
D DEFINE I Y<0 D ABTMSG Q
;
S VSET=""
F I=2.1,2.2,2.3 S VER(I)="",VSET=VSET_$TR(I,".")_":"_I_";"
;
; update data dictionary for file 869.2
;
I $P(^DD(869.2,200.08,0),U,3)'["2.3" S $P(^(0),U,3)=VSET,^("DT")="2970416"
;
; update entries in file 771.5
;
S DIC="^HL(771.5,"
S DIC(0)="L"
S DLAYGO=771.5
S DIC("DR")="2///HEALTH LEVEL SEVEN"
S V=0
F S V=$O(VER(V)) Q:'V S X=V D DEFINE I Y<0 D ABTMSG Q
Q:(Y<0)
K DR,DLAYGO,DIC
;
W !,"Adding New HL7 Versions to All Message and Event Types.",!
;
S V=0
F S V=$O(VER(V)) Q:'V S VER(V)=$O(^HL(771.5,"B",V,0)) I 'VER(V) D ABTMSG Q
Q:V
;
D ADD(771.2,3,"V") Q:(Y<0)
D ADD(779.001,100,1) Q:(Y<0)
;
W !,"HL File Update is Complete.",!
Q
;
ADD(FILE,FIELD,SUB) ; Add new versions to one file
;
S DIC(0)="L"
S DIC("P")=$P(^DD(FILE,FIELD,0),U,2)
S I=0
F S I=$O(^HL(FILE,I)) Q:'I S DA(1)=I,DIC="^HL(FILE,"_DA(1)_","""_SUB_"""," D ADDVER I Y<0 D ABTMSG Q
Q
;
ADDVER ; Add new HL versions to one message or event type
;
S V=0
F S V=$O(VER(V)) Q:'V S X=VER(V) D DEFINE Q:(Y<0)
Q
;
DEFINE ; define one file entry (if it doesn't already exist)
;
S GBL=DIC_"""B"","""_X_""")"
I $D(@GBL) S Y=0 Q
K DD,DO,Y D FILE^DICN
Q
;
ABTMSG ; write abort message
;
W !,*7,"*** Aborting due to Fileman error ***"
W !,"*** Update is not complete. ***"
Q
HLUPDATE ; IHS/TUC/DLR - UPDATE HL FILE ENTRIES ; [ 04/02/2003 8:36 AM ]
+1 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
+2 ;
+3 ; This routine updates the HL package file entries
+4 ; to support the current version of the HL7 standard.
+5 ; It is run from the M prompt, after HLINIT. It takes
+6 ; no input variables and produces no output variables.
+7 ;
+8 NEW %,DA,DIC,GBL,I,V,VER,VSET,X,Y
+9 DO ^XBKVAR
+10 ;
+11 WRITE !,"Creating New HL7 Message Definitions.",!
+12 ;
+13 SET X="VXU"
SET DIC="^HL(771.2,"
SET DIC(0)="L"
SET DLAYGO=771.2
+14 SET DIC("DR")="2///Unsolicited Vaccination Record Update"
+15 DO DEFINE
IF Y<0
DO ABTMSG
QUIT
+16 ;
+17 SET X="V04"
SET DIC="^HL(779.001,"
SET DIC(0)="L"
SET DLAYGO=779.001
+18 SET DIC("DR")="2///Unsolicited Vaccination Record Update"
+19 DO DEFINE
IF Y<0
DO ABTMSG
QUIT
+20 ;
+21 SET VSET=""
+22 FOR I=2.1,2.2,2.3
SET VER(I)=""
SET VSET=VSET_$TRANSLATE(I,".")_":"_I_";"
+23 ;
+24 ; update data dictionary for file 869.2
+25 ;
+26 IF $PIECE(^DD(869.2,200.08,0),U,3)'["2.3"
SET $PIECE(^(0),U,3)=VSET
SET ^("DT")="2970416"
+27 ;
+28 ; update entries in file 771.5
+29 ;
+30 SET DIC="^HL(771.5,"
+31 SET DIC(0)="L"
+32 SET DLAYGO=771.5
+33 SET DIC("DR")="2///HEALTH LEVEL SEVEN"
+34 SET V=0
+35 FOR
SET V=$ORDER(VER(V))
IF 'V
QUIT
SET X=V
DO DEFINE
IF Y<0
DO ABTMSG
QUIT
+36 IF (Y<0)
QUIT
+37 KILL DR,DLAYGO,DIC
+38 ;
+39 WRITE !,"Adding New HL7 Versions to All Message and Event Types.",!
+40 ;
+41 SET V=0
+42 FOR
SET V=$ORDER(VER(V))
IF 'V
QUIT
SET VER(V)=$ORDER(^HL(771.5,"B",V,0))
IF 'VER(V)
DO ABTMSG
QUIT
+43 IF V
QUIT
+44 ;
+45 DO ADD(771.2,3,"V")
IF (Y<0)
QUIT
+46 DO ADD(779.001,100,1)
IF (Y<0)
QUIT
+47 ;
+48 WRITE !,"HL File Update is Complete.",!
+49 QUIT
+50 ;
ADD(FILE,FIELD,SUB) ; Add new versions to one file
+1 ;
+2 SET DIC(0)="L"
+3 SET DIC("P")=$PIECE(^DD(FILE,FIELD,0),U,2)
+4 SET I=0
+5 FOR
SET I=$ORDER(^HL(FILE,I))
IF 'I
QUIT
SET DA(1)=I
SET DIC="^HL(FILE,"_DA(1)_","""_SUB_""","
DO ADDVER
IF Y<0
DO ABTMSG
QUIT
+6 QUIT
+7 ;
ADDVER ; Add new HL versions to one message or event type
+1 ;
+2 SET V=0
+3 FOR
SET V=$ORDER(VER(V))
IF 'V
QUIT
SET X=VER(V)
DO DEFINE
IF (Y<0)
QUIT
+4 QUIT
+5 ;
DEFINE ; define one file entry (if it doesn't already exist)
+1 ;
+2 SET GBL=DIC_"""B"","""_X_""")"
+3 IF $DATA(@GBL)
SET Y=0
QUIT
+4 KILL DD,DO,Y
DO FILE^DICN
+5 QUIT
+6 ;
ABTMSG ; write abort message
+1 ;
+2 WRITE !,*7,"*** Aborting due to Fileman error ***"
+3 WRITE !,"*** Update is not complete. ***"
+4 QUIT
