XUMF502P ;OIFO-BP/RAM - Master File Parameters Mappings ;8/11/09 06:39
;;8.0;KERNEL;**502**;Jul 10, 1995;Build 17
;Per VHA Directive 10-92-142, this routine should not be modified
;
Q
;
MAIN ; -- Entry point
;
;Q:'$D(^DD(757.33))
;
N FDA,IENS,FIELD,ERR,SEQ,XUMF,X
;
S XUMF=1,IEN=757.33
;
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
S IENS=IEN_","
;S FDA(4.001,IENS,.01)=757.33
S FDA(4.001,IENS,.03)="Mappings"
S FDA(4.001,IENS,.07)="Mappings"
S FDA(4.001,IENS,.08)="B"
S FDA(4.001,IENS,.09)="MapDefinition"
S FDA(4.001,IENS,4)="D MFE^XUMF502"
S FDA(4.001,IENS,5)="D ZRT^XUMF502"
;S FDA(4.001,IENS,2)="D MFSUP^HDISVF09(,$G(ERROR))"
;
D UPDATE^DIE("E","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)="MapDefinition"
S FDA(4.011,IENS,.02)=.02
S FDA(4.011,IENS,.15)=1,FDA(4.011,IENS,.13)="VUID"
;
S IENS="+2,"_IEN_","
S FDA(4.011,IENS,.01)="SourceCode"
S FDA(4.011,IENS,.02)=1
S FDA(4.011,IENS,.15)=2
;
S IENS="+3,"_IEN_","
S FDA(4.011,IENS,.01)="TargetCode"
S FDA(4.011,IENS,.02)=2
S FDA(4.011,IENS,.15)=3
;
S IENS="+4,"_IEN_","
S FDA(4.011,IENS,.01)="Order"
S FDA(4.011,IENS,.02)=4
S FDA(4.011,IENS,.15)=4
;
S IENS="+5,"_IEN_","
S FDA(4.011,IENS,.01)="Status"
S FDA(4.011,IENS,.02)=.01
S FDA(4.011,IENS,.04)=757.333
S FDA(4.011,IENS,.06)="Status"
S FDA(4.011,IENS,.15)=5
;
;S IENS="+6,"_IEN_","
;S FDA(4.011,IENS,.01)="Status"
;S FDA(4.011,IENS,.02)=.02
;S FDA(4.011,IENS,.04)=757.333
;S FDA(4.011,IENS,.06)="EffectiveDate"
;S FDA(4.011,IENS,.15)=6
;
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","Mappings",0))
;
I 'IEN D Q:'IEN
.K FDA
.S FDA(4.005,"+1,",.01)="Mappings"
.;
.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","Mappings",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)=757.33
D UPDATE^DIE("E","FDA",,"ERR")
I $D(ERR) D
.D EM("UPDATE MD5 1 error",.ERR)
.K ERR
;
S IENS1=757.33_","_IENS
;
K FDA
S FDA(4.00511,"+1,"_IENS1,.01)=.01
S FDA(4.00511,"+1,"_IENS1,1)=10
S FDA(4.00511,"+2,"_IENS1,.01)=1
S FDA(4.00511,"+2,"_IENS1,1)=20
S FDA(4.00511,"+3,"_IENS1,.01)=2
S FDA(4.00511,"+3,"_IENS1,1)=30
S FDA(4.00511,"+4,"_IENS1,.01)=4
S FDA(4.00511,"+4,"_IENS1,1)=40
;
D UPDATE^DIE("E","FDA",,"ERR")
I $D(ERR) D
.D EM("UPDATE MD5 2 error",.ERR)
.K ERR
;
K FDA
S FDA(4.005,IENS,7)="B"
S FDA(4.005,IENS,8)=".02"
D UPDATE^DIE("E","FDA",,"ERR")
I $D(ERR) D
.D EM("UPDATE MD5 3 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[HXUMF502P 3660 printed Dec 13, 2024@02:10:26 Page 2
XUMF502P ;OIFO-BP/RAM - Master File Parameters Mappings ;8/11/09 06:39
+1 ;;8.0;KERNEL;**502**;Jul 10, 1995;Build 17
+2 ;Per VHA Directive 10-92-142, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
MAIN ; -- Entry point
+1 ;
+2 ;Q:'$D(^DD(757.33))
+3 ;
+4 NEW FDA,IENS,FIELD,ERR,SEQ,XUMF,X
+5 ;
+6 SET XUMF=1
SET IEN=757.33
+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 SET IENS=IEN_","
+6 ;S FDA(4.001,IENS,.01)=757.33
+7 SET FDA(4.001,IENS,.03)="Mappings"
+8 SET FDA(4.001,IENS,.07)="Mappings"
+9 SET FDA(4.001,IENS,.08)="B"
+10 SET FDA(4.001,IENS,.09)="MapDefinition"
+11 SET FDA(4.001,IENS,4)="D MFE^XUMF502"
+12 SET FDA(4.001,IENS,5)="D ZRT^XUMF502"
+13 ;S FDA(4.001,IENS,2)="D MFSUP^HDISVF09(,$G(ERROR))"
+14 ;
+15 DO UPDATE^DIE("E","FDA",,"ERR")
+16 IF $DATA(ERR)
Begin DoDot:1
+17 DO EM("UPDATE ZERO error",.ERR)
+18 KILL ERR
End DoDot:1
+19 ;
+20 QUIT
+21 ;
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)="MapDefinition"
+5 SET FDA(4.011,IENS,.02)=.02
+6 SET FDA(4.011,IENS,.15)=1
SET FDA(4.011,IENS,.13)="VUID"
+7 ;
+8 SET IENS="+2,"_IEN_","
+9 SET FDA(4.011,IENS,.01)="SourceCode"
+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)="TargetCode"
+15 SET FDA(4.011,IENS,.02)=2
+16 SET FDA(4.011,IENS,.15)=3
+17 ;
+18 SET IENS="+4,"_IEN_","
+19 SET FDA(4.011,IENS,.01)="Order"
+20 SET FDA(4.011,IENS,.02)=4
+21 SET FDA(4.011,IENS,.15)=4
+22 ;
+23 SET IENS="+5,"_IEN_","
+24 SET FDA(4.011,IENS,.01)="Status"
+25 SET FDA(4.011,IENS,.02)=.01
+26 SET FDA(4.011,IENS,.04)=757.333
+27 SET FDA(4.011,IENS,.06)="Status"
+28 SET FDA(4.011,IENS,.15)=5
+29 ;
+30 ;S IENS="+6,"_IEN_","
+31 ;S FDA(4.011,IENS,.01)="Status"
+32 ;S FDA(4.011,IENS,.02)=.02
+33 ;S FDA(4.011,IENS,.04)=757.333
+34 ;S FDA(4.011,IENS,.06)="EffectiveDate"
+35 ;S FDA(4.011,IENS,.15)=6
+36 ;
+37 DO UPDATE^DIE("E","FDA",,"ERR")
+38 IF $DATA(ERR)
Begin DoDot:1
+39 DO EM("UPDATE NODES error",.ERR)
+40 KILL ERR
End DoDot:1
+41 ;
+42 QUIT
+43 ;
MD5 ; -- MD5
+1 ;
+2 NEW IENS1
+3 ;
+4 SET IEN=$ORDER(^DIC(4.005,"B","Mappings",0))
+5 ;
+6 IF 'IEN
Begin DoDot:1
+7 KILL FDA
+8 SET FDA(4.005,"+1,",.01)="Mappings"
+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","Mappings",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)=757.33
+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=757.33_","_IENS
+34 ;
+35 KILL FDA
+36 SET FDA(4.00511,"+1,"_IENS1,.01)=.01
+37 SET FDA(4.00511,"+1,"_IENS1,1)=10
+38 SET FDA(4.00511,"+2,"_IENS1,.01)=1
+39 SET FDA(4.00511,"+2,"_IENS1,1)=20
+40 SET FDA(4.00511,"+3,"_IENS1,.01)=2
+41 SET FDA(4.00511,"+3,"_IENS1,1)=30
+42 SET FDA(4.00511,"+4,"_IENS1,.01)=4
+43 SET FDA(4.00511,"+4,"_IENS1,1)=40
+44 ;
+45 DO UPDATE^DIE("E","FDA",,"ERR")
+46 IF $DATA(ERR)
Begin DoDot:1
+47 DO EM("UPDATE MD5 2 error",.ERR)
+48 KILL ERR
End DoDot:1
+49 ;
+50 KILL FDA
+51 SET FDA(4.005,IENS,7)="B"
+52 SET FDA(4.005,IENS,8)=".02"
+53 DO UPDATE^DIE("E","FDA",,"ERR")
+54 IF $DATA(ERR)
Begin DoDot:1
+55 DO EM("UPDATE MD5 3 error",.ERR)
+56 KILL ERR
End DoDot:1
+57 ;
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 SET XMY("G.XUMF ERROR")=""
SET XMDUZ=.5
+10 ;S XMY("G.XUMF TEST")="",XMDUZ=.5
+11 SET XMTEXT="X("
+12 ;
+13 DO ^XMD
+14 ;
+15 QUIT
+16 ;
