- 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 Feb 18, 2025@23:36:52 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 ;