Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUMF502P

XUMF502P.m

Go to the documentation of this file.
  1. XUMF502P ;OIFO-BP/RAM - Master File Parameters Mappings ;8/11/09 06:39
  1. ;;8.0;KERNEL;**502**;Jul 10, 1995;Build 17
  1. ;Per VHA Directive 10-92-142, this routine should not be modified
  1. ;
  1. Q
  1. ;
  1. MAIN ; -- Entry point
  1. ;
  1. ;Q:'$D(^DD(757.33))
  1. ;
  1. N FDA,IENS,FIELD,ERR,SEQ,XUMF,X
  1. ;
  1. S XUMF=1,IEN=757.33
  1. ;
  1. D ZERO,CLEAN,NODES,MD5,EXIT
  1. ;
  1. Q
  1. ;
  1. ZERO ; -- zero node
  1. ;
  1. N DIC,DA,X,DINUM,Y
  1. ;
  1. K DIC S DIC="^DIC(4.001,",X=IEN,DINUM=X,DIC(0)="F" D FILE^DICN K DIC
  1. S IENS=IEN_","
  1. ;S FDA(4.001,IENS,.01)=757.33
  1. S FDA(4.001,IENS,.03)="Mappings"
  1. S FDA(4.001,IENS,.07)="Mappings"
  1. S FDA(4.001,IENS,.08)="B"
  1. S FDA(4.001,IENS,.09)="MapDefinition"
  1. S FDA(4.001,IENS,4)="D MFE^XUMF502"
  1. S FDA(4.001,IENS,5)="D ZRT^XUMF502"
  1. ;S FDA(4.001,IENS,2)="D MFSUP^HDISVF09(,$G(ERROR))"
  1. ;
  1. D UPDATE^DIE("E","FDA",,"ERR")
  1. I $D(ERR) D
  1. .D EM("UPDATE ZERO error",.ERR)
  1. .K ERR
  1. ;
  1. Q
  1. ;
  1. CLEAN ; -- clean out SEQUENCE
  1. ;
  1. K FDA
  1. S SEQ=0
  1. F S SEQ=$O(^DIC(4.001,IEN,1,SEQ)) Q:'SEQ D
  1. .S IENS=SEQ_","_IEN_","
  1. .S FDA(4.011,IENS,.01)="@"
  1. ;
  1. D FILE^DIE("E","FDA")
  1. ;
  1. Q
  1. ;
  1. NODES ; -- SEQUENCE
  1. ;
  1. K FDA
  1. S IENS="+1,"_IEN_","
  1. S FDA(4.011,IENS,.01)="MapDefinition"
  1. S FDA(4.011,IENS,.02)=.02
  1. S FDA(4.011,IENS,.15)=1,FDA(4.011,IENS,.13)="VUID"
  1. ;
  1. S IENS="+2,"_IEN_","
  1. S FDA(4.011,IENS,.01)="SourceCode"
  1. S FDA(4.011,IENS,.02)=1
  1. S FDA(4.011,IENS,.15)=2
  1. ;
  1. S IENS="+3,"_IEN_","
  1. S FDA(4.011,IENS,.01)="TargetCode"
  1. S FDA(4.011,IENS,.02)=2
  1. S FDA(4.011,IENS,.15)=3
  1. ;
  1. S IENS="+4,"_IEN_","
  1. S FDA(4.011,IENS,.01)="Order"
  1. S FDA(4.011,IENS,.02)=4
  1. S FDA(4.011,IENS,.15)=4
  1. ;
  1. S IENS="+5,"_IEN_","
  1. S FDA(4.011,IENS,.01)="Status"
  1. S FDA(4.011,IENS,.02)=.01
  1. S FDA(4.011,IENS,.04)=757.333
  1. S FDA(4.011,IENS,.06)="Status"
  1. S FDA(4.011,IENS,.15)=5
  1. ;
  1. ;S IENS="+6,"_IEN_","
  1. ;S FDA(4.011,IENS,.01)="Status"
  1. ;S FDA(4.011,IENS,.02)=.02
  1. ;S FDA(4.011,IENS,.04)=757.333
  1. ;S FDA(4.011,IENS,.06)="EffectiveDate"
  1. ;S FDA(4.011,IENS,.15)=6
  1. ;
  1. D UPDATE^DIE("E","FDA",,"ERR")
  1. I $D(ERR) D
  1. .D EM("UPDATE NODES error",.ERR)
  1. .K ERR
  1. ;
  1. Q
  1. ;
  1. MD5 ; -- MD5
  1. ;
  1. N IENS1
  1. ;
  1. S IEN=$O(^DIC(4.005,"B","Mappings",0))
  1. ;
  1. I 'IEN D Q:'IEN
  1. .K FDA
  1. .S FDA(4.005,"+1,",.01)="Mappings"
  1. .;
  1. .D UPDATE^DIE("E","FDA",,"ERR")
  1. .I $D(ERR) D
  1. ..D EM("UPDATE MD5 error",.ERR)
  1. ..K ERR
  1. .S IEN=$O(^DIC(4.005,"B","Mappings",0))
  1. ;
  1. S IENS=IEN_","
  1. ;
  1. K FDA
  1. S SEQ=0
  1. F S SEQ=$O(^DIC(4.005,IEN,1,SEQ)) Q:'SEQ D
  1. .S IENS1=SEQ_","_IEN_","
  1. .S FDA(4.0051,IENS1,.01)="@"
  1. D FILE^DIE("E","FDA","ERR")
  1. ;
  1. K FDA
  1. S IENS1="+1,"_IENS
  1. S FDA(4.0051,IENS1,.01)=757.33
  1. D UPDATE^DIE("E","FDA",,"ERR")
  1. I $D(ERR) D
  1. .D EM("UPDATE MD5 1 error",.ERR)
  1. .K ERR
  1. ;
  1. S IENS1=757.33_","_IENS
  1. ;
  1. K FDA
  1. S FDA(4.00511,"+1,"_IENS1,.01)=.01
  1. S FDA(4.00511,"+1,"_IENS1,1)=10
  1. S FDA(4.00511,"+2,"_IENS1,.01)=1
  1. S FDA(4.00511,"+2,"_IENS1,1)=20
  1. S FDA(4.00511,"+3,"_IENS1,.01)=2
  1. S FDA(4.00511,"+3,"_IENS1,1)=30
  1. S FDA(4.00511,"+4,"_IENS1,.01)=4
  1. S FDA(4.00511,"+4,"_IENS1,1)=40
  1. ;
  1. D UPDATE^DIE("E","FDA",,"ERR")
  1. I $D(ERR) D
  1. .D EM("UPDATE MD5 2 error",.ERR)
  1. .K ERR
  1. ;
  1. K FDA
  1. S FDA(4.005,IENS,7)="B"
  1. S FDA(4.005,IENS,8)=".02"
  1. D UPDATE^DIE("E","FDA",,"ERR")
  1. I $D(ERR) D
  1. .D EM("UPDATE MD5 3 error",.ERR)
  1. .K ERR
  1. ;
  1. EXIT ; -- cleanup, and quit
  1. ;
  1. Q
  1. ;
  1. EM(ERROR,ERR,XMSUB,XMY) ; -- error message
  1. ;
  1. N X,XMTEXT
  1. ;
  1. D MSG^DIALOG("AM",.X,80,,"ERR")
  1. ;
  1. S X(.1)="HL7 message ID: "_$G(HL("MID"))
  1. S X(.2)="",X(.3)=$G(ERROR),X(.4)=""
  1. S:$G(XMSUB)="" XMSUB="MFS ERROR"
  1. S XMY("G.XUMF ERROR")="",XMDUZ=.5
  1. ;S XMY("G.XUMF TEST")="",XMDUZ=.5
  1. S XMTEXT="X("
  1. ;
  1. D ^XMD
  1. ;
  1. Q
  1. ;