XUMF479P ;OIFO-BP/RAM - Master File Parameters Med Routes ;06/28/00
;;8.0;KERNEL;**479**;Jul 10, 1995;Build 9
;Per VHA Directive 2004-038, this routine should not be modified
;
Q
;
MAIN ; -- Entry point
;
;Q:'$D(^DD(51.23))
;
N FDA,IENS,FIELD,ERR,SEQ,XUMF,X,IEN,XMDUZ
;
S XUMF=1,IEN=51.23
;
D ZERO,CLEAN,NODES,MD5,EXIT
;
Q
;
ZERO ; -- zero node
;
N DIC,DA,X,DINUM,Y
;
K DIC S DIC="^DIC(4.001,",X=IEN,DINUM=X,DIC(0)="F" D FILE^DICN K DIC
;
K FDA
S IENS=IEN_","
;
S FDA(4.001,IENS,.01)=51.23
S FDA(4.001,IENS,.03)="Medication Routes"
S FDA(4.001,IENS,.07)="Medication Routes"
S FDA(4.001,IENS,2)="D MFSUP^HDISVF09(51.23,$G(ERROR))"
;
D UPDATE^DIE("","FDA",,"ERR")
I $D(ERR) D
.D EM("UPDATE ZERO error",.ERR)
.K ERR
;
Q
;
CLEAN ; -- clean out SEQUENCE
;
K FDA
S SEQ=0
F S SEQ=$O(^DIC(4.001,IEN,1,SEQ)) Q:'SEQ D
.S IENS=SEQ_","_IEN_","
.S FDA(4.011,IENS,.01)="@"
;
D FILE^DIE("E","FDA")
;
Q
;
NODES ; -- SEQUENCE
;
K FDA
S IENS="+1,"_IEN_","
S FDA(4.011,IENS,.01)="Term"
S FDA(4.011,IENS,.02)=.01
S FDA(4.011,IENS,.15)=1
;
S IENS="+2,"_IEN_","
S FDA(4.011,IENS,.01)="FDB_Med_Route"
S FDA(4.011,IENS,.02)=1
S FDA(4.011,IENS,.15)=2
;
S IENS="+3,"_IEN_","
S FDA(4.011,IENS,.01)="vista_replaced_by"
S FDA(4.011,IENS,.02)=99.97
S FDA(4.011,IENS,.15)=3
S FDA(4.011,IENS,.13)="VUID"
;
;S IENS="+4,"_IEN_","
;S FDA(4.011,IENS,.01)="EffectiveDate"
;S FDA(4.011,IENS,.02)=.01
;S FDA(4.011,IENS,.04)=51.2399
;S FDA(4.011,IENS,.06)="EffectiveDate"
;S FDA(4.011,IENS,.15)=4
;
S IENS="+4,"_IEN_","
S FDA(4.011,IENS,.01)="Status"
S FDA(4.011,IENS,.02)=.02
S FDA(4.011,IENS,.04)=51.2399
S FDA(4.011,IENS,.06)="Status"
S FDA(4.011,IENS,.15)=4
;
D UPDATE^DIE("E","FDA",,"ERR")
I $D(ERR) D
.D EM("UPDATE NODES error",.ERR)
.K ERR
;
Q
;
MD5 ; -- MD5
;
N IENS1
;
S IEN=$O(^DIC(4.005,"B","Medication Routes",0))
;
I 'IEN D Q:'IEN
.K FDA
.S FDA(4.005,"+1,",.01)="Medication Routes"
.;
.D UPDATE^DIE("E","FDA",,"ERR")
.I $D(ERR) D
..D EM("UPDATE MD5 error",.ERR)
..K ERR
.S IEN=$O(^DIC(4.005,"B","Medication Routes",0))
;
S IENS=IEN_","
;
K FDA
S SEQ=0
F S SEQ=$O(^DIC(4.005,IEN,1,SEQ)) Q:'SEQ D
.S IENS1=SEQ_","_IEN_","
.S FDA(4.0051,IENS1,.01)="@"
D FILE^DIE("E","FDA","ERR")
;
K FDA
S IENS1="+1,"_IENS
S FDA(4.0051,IENS1,.01)=51.23
D UPDATE^DIE("E","FDA",,"ERR")
I $D(ERR) D
.D EM("UPDATE MD5 1 error",.ERR)
.K ERR
;
S IENS1=51.23_","_IENS
;
K FDA
S FDA(4.00511,"+1,"_IENS1,.01)=.01
S FDA(4.00511,"+1,"_IENS1,1)=20
S FDA(4.00511,"+2,"_IENS1,.01)=1
S FDA(4.00511,"+2,"_IENS1,1)=30
S FDA(4.00511,"+3,"_IENS1,.01)=99.99
S FDA(4.00511,"+3,"_IENS1,1)=10
S FDA(4.00511,"+4,"_IENS1,.01)=99.97
S FDA(4.00511,"+4,"_IENS1,1)=40
S FDA(4.00511,"+4,"_IENS1,2)="EXTERNAL"
S FDA(4.00511,"+4,"_IENS1,3)=51.23
;
D UPDATE^DIE("E","FDA",,"ERR")
I $D(ERR) D
.D EM("UPDATE MD5 2 error",.ERR)
.K ERR
;
EXIT ; -- cleanup, and quit
;
Q
;
EM(ERROR,ERR,XMSUB,XMY) ; -- error message
;
N X,XMTEXT
;
D MSG^DIALOG("AM",.X,80,,"ERR")
;
S X(.1)="HL7 message ID: "_$G(HL("MID"))
S X(.2)="",X(.3)=$G(ERROR),X(.4)=""
S:$G(XMSUB)="" XMSUB="MFS ERROR"
;S XMY("G.XUMF ERROR")="",XMDUZ=.5
S XMY("G.XUMF TEST")="",XMDUZ=.5
S XMTEXT="X("
;
D ^XMD
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMF479P 3413 printed Apr 09, 2024@21:18:56 Page 2
XUMF479P ;OIFO-BP/RAM - Master File Parameters Med Routes ;06/28/00
+1 ;;8.0;KERNEL;**479**;Jul 10, 1995;Build 9
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
MAIN ; -- Entry point
+1 ;
+2 ;Q:'$D(^DD(51.23))
+3 ;
+4 NEW FDA,IENS,FIELD,ERR,SEQ,XUMF,X,IEN,XMDUZ
+5 ;
+6 SET XUMF=1
SET IEN=51.23
+7 ;
+8 DO ZERO
DO CLEAN
DO NODES
DO MD5
DO EXIT
+9 ;
+10 QUIT
+11 ;
ZERO ; -- zero node
+1 ;
+2 NEW DIC,DA,X,DINUM,Y
+3 ;
+4 KILL DIC
SET DIC="^DIC(4.001,"
SET X=IEN
SET DINUM=X
SET DIC(0)="F"
DO FILE^DICN
KILL DIC
+5 ;
+6 KILL FDA
+7 SET IENS=IEN_","
+8 ;
+9 SET FDA(4.001,IENS,.01)=51.23
+10 SET FDA(4.001,IENS,.03)="Medication Routes"
+11 SET FDA(4.001,IENS,.07)="Medication Routes"
+12 SET FDA(4.001,IENS,2)="D MFSUP^HDISVF09(51.23,$G(ERROR))"
+13 ;
+14 DO UPDATE^DIE("","FDA",,"ERR")
+15 IF $DATA(ERR)
Begin DoDot:1
+16 DO EM("UPDATE ZERO error",.ERR)
+17 KILL ERR
End DoDot:1
+18 ;
+19 QUIT
+20 ;
CLEAN ; -- clean out SEQUENCE
+1 ;
+2 KILL FDA
+3 SET SEQ=0
+4 FOR
SET SEQ=$ORDER(^DIC(4.001,IEN,1,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+5 SET IENS=SEQ_","_IEN_","
+6 SET FDA(4.011,IENS,.01)="@"
End DoDot:1
+7 ;
+8 DO FILE^DIE("E","FDA")
+9 ;
+10 QUIT
+11 ;
NODES ; -- SEQUENCE
+1 ;
+2 KILL FDA
+3 SET IENS="+1,"_IEN_","
+4 SET FDA(4.011,IENS,.01)="Term"
+5 SET FDA(4.011,IENS,.02)=.01
+6 SET FDA(4.011,IENS,.15)=1
+7 ;
+8 SET IENS="+2,"_IEN_","
+9 SET FDA(4.011,IENS,.01)="FDB_Med_Route"
+10 SET FDA(4.011,IENS,.02)=1
+11 SET FDA(4.011,IENS,.15)=2
+12 ;
+13 SET IENS="+3,"_IEN_","
+14 SET FDA(4.011,IENS,.01)="vista_replaced_by"
+15 SET FDA(4.011,IENS,.02)=99.97
+16 SET FDA(4.011,IENS,.15)=3
+17 SET FDA(4.011,IENS,.13)="VUID"
+18 ;
+19 ;S IENS="+4,"_IEN_","
+20 ;S FDA(4.011,IENS,.01)="EffectiveDate"
+21 ;S FDA(4.011,IENS,.02)=.01
+22 ;S FDA(4.011,IENS,.04)=51.2399
+23 ;S FDA(4.011,IENS,.06)="EffectiveDate"
+24 ;S FDA(4.011,IENS,.15)=4
+25 ;
+26 SET IENS="+4,"_IEN_","
+27 SET FDA(4.011,IENS,.01)="Status"
+28 SET FDA(4.011,IENS,.02)=.02
+29 SET FDA(4.011,IENS,.04)=51.2399
+30 SET FDA(4.011,IENS,.06)="Status"
+31 SET FDA(4.011,IENS,.15)=4
+32 ;
+33 DO UPDATE^DIE("E","FDA",,"ERR")
+34 IF $DATA(ERR)
Begin DoDot:1
+35 DO EM("UPDATE NODES error",.ERR)
+36 KILL ERR
End DoDot:1
+37 ;
+38 QUIT
+39 ;
MD5 ; -- MD5
+1 ;
+2 NEW IENS1
+3 ;
+4 SET IEN=$ORDER(^DIC(4.005,"B","Medication Routes",0))
+5 ;
+6 IF 'IEN
Begin DoDot:1
+7 KILL FDA
+8 SET FDA(4.005,"+1,",.01)="Medication Routes"
+9 ;
+10 DO UPDATE^DIE("E","FDA",,"ERR")
+11 IF $DATA(ERR)
Begin DoDot:2
+12 DO EM("UPDATE MD5 error",.ERR)
+13 KILL ERR
End DoDot:2
+14 SET IEN=$ORDER(^DIC(4.005,"B","Medication Routes",0))
End DoDot:1
if 'IEN
QUIT
+15 ;
+16 SET IENS=IEN_","
+17 ;
+18 KILL FDA
+19 SET SEQ=0
+20 FOR
SET SEQ=$ORDER(^DIC(4.005,IEN,1,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+21 SET IENS1=SEQ_","_IEN_","
+22 SET FDA(4.0051,IENS1,.01)="@"
End DoDot:1
+23 DO FILE^DIE("E","FDA","ERR")
+24 ;
+25 KILL FDA
+26 SET IENS1="+1,"_IENS
+27 SET FDA(4.0051,IENS1,.01)=51.23
+28 DO UPDATE^DIE("E","FDA",,"ERR")
+29 IF $DATA(ERR)
Begin DoDot:1
+30 DO EM("UPDATE MD5 1 error",.ERR)
+31 KILL ERR
End DoDot:1
+32 ;
+33 SET IENS1=51.23_","_IENS
+34 ;
+35 KILL FDA
+36 SET FDA(4.00511,"+1,"_IENS1,.01)=.01
+37 SET FDA(4.00511,"+1,"_IENS1,1)=20
+38 SET FDA(4.00511,"+2,"_IENS1,.01)=1
+39 SET FDA(4.00511,"+2,"_IENS1,1)=30
+40 SET FDA(4.00511,"+3,"_IENS1,.01)=99.99
+41 SET FDA(4.00511,"+3,"_IENS1,1)=10
+42 SET FDA(4.00511,"+4,"_IENS1,.01)=99.97
+43 SET FDA(4.00511,"+4,"_IENS1,1)=40
+44 SET FDA(4.00511,"+4,"_IENS1,2)="EXTERNAL"
+45 SET FDA(4.00511,"+4,"_IENS1,3)=51.23
+46 ;
+47 DO UPDATE^DIE("E","FDA",,"ERR")
+48 IF $DATA(ERR)
Begin DoDot:1
+49 DO EM("UPDATE MD5 2 error",.ERR)
+50 KILL ERR
End DoDot:1
+51 ;
EXIT ; -- cleanup, and quit
+1 ;
+2 QUIT
+3 ;
EM(ERROR,ERR,XMSUB,XMY) ; -- error message
+1 ;
+2 NEW X,XMTEXT
+3 ;
+4 DO MSG^DIALOG("AM",.X,80,,"ERR")
+5 ;
+6 SET X(.1)="HL7 message ID: "_$GET(HL("MID"))
+7 SET X(.2)=""
SET X(.3)=$GET(ERROR)
SET X(.4)=""
+8 if $GET(XMSUB)=""
SET XMSUB="MFS ERROR"
+9 ;S XMY("G.XUMF ERROR")="",XMDUZ=.5
+10 SET XMY("G.XUMF TEST")=""
SET XMDUZ=.5
+11 SET XMTEXT="X("
+12 ;
+13 DO ^XMD
+14 ;
+15 QUIT
+16 ;
