XUMF502 ;RAM - XUMF502 ;04/15/02 ;9/10/08 11:55
;;8.0;KERNEL;**502**;Jul 10, 1995;Build 17
;
Q
;
;
MFE ;
;
N X,Y
;
S IEN=$O(^LEX(757.33,"B",VUID,0))
;
Q:IEN
;
D CHK^DIE(757.33,.01,,VUID,.X)
I X="^" S ERROR="1^validation error 757.33 MAPPINGS FILE map ID= "_VUID Q
K DIC S DIC=757.33,DIC(0)="F" D FILE^DICN K DIC
I Y="-1" S ERROR="1^error 757.33 MAPPINGS FILE map ID= "_VUID Q
S IEN=+Y,RECORD("NEW")=1
;
Q
;
ZRT ;
;
I $G(NAME)="EffectiveDate" D STATUS Q
I $G(NAME)="MapDefinition" D MAPDEF Q
;
Q
;
STATUS ;
;
I $D(FDA) D UPDATE^XUMF1H K FDA
;
N VALUE,FDA
;
S VALUE=$$UNESC^XUMF0($P(HLNODE,HLFS,3),.HL)
S VALUE=$$DTYP^XUMFXP(VALUE,"DT",HLCS,0,"L")
;
;S IEN1=$O(^LEX(757.33,2485,2,99999),-1),IEN1=IEN1+1
;
K FDA
S FDA(757.333,"?+1,"_IEN_",",.01)=VALUE
;
X HLNEXT I HLQUIT'>0 S ERROR="1^status error" Q
;
I $P(HLNODE,HLFS,2)'="Active" S ERROR="1^status error" Q
S VALUE=$$UNESC^XUMF0($P(HLNODE,HLFS,3),.HL)
S VALUE=$$DTYP^XUMFXP(VALUE,"ST",HLCS,0)
;
S FDA(757.333,"?+1,"_IEN_",",1)=$S(VALUE:"ACTIVE",1:"INACTIVE")
;
D UPDATE^DIE("E","FDA",,"ERR")
I $D(ERR) D Q
.S ERROR="1^status update error"
.D EM^XUMF1H(ERROR,.ERR) K ERR
;
S OUT=1
;
Q
;
MAPDEF ;
;
N VALUE,IENS
;
S IENS=IEN_","
S VALUE=$$UNESC^XUMF0($P(HLNODE,HLFS,3),.HL)
S VALUE=$O(^LEX(757.32,"C",VALUE,0))
S FDA(IFN,IENS,.02)=VALUE
S OUT=1
;
Q
;
STAT() ;
;
N X
S X=$O(^LEX(757.33,IEN,2,999),-1) Q:'X ""
Q $P($G(^LEX(757.33,IEN,2,X,0)),U,2)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMF502 1548 printed Dec 13, 2024@02:10:25 Page 2
XUMF502 ;RAM - XUMF502 ;04/15/02 ;9/10/08 11:55
+1 ;;8.0;KERNEL;**502**;Jul 10, 1995;Build 17
+2 ;
+3 QUIT
+4 ;
+5 ;
MFE ;
+1 ;
+2 NEW X,Y
+3 ;
+4 SET IEN=$ORDER(^LEX(757.33,"B",VUID,0))
+5 ;
+6 if IEN
QUIT
+7 ;
+8 DO CHK^DIE(757.33,.01,,VUID,.X)
+9 IF X="^"
SET ERROR="1^validation error 757.33 MAPPINGS FILE map ID= "_VUID
QUIT
+10 KILL DIC
SET DIC=757.33
SET DIC(0)="F"
DO FILE^DICN
KILL DIC
+11 IF Y="-1"
SET ERROR="1^error 757.33 MAPPINGS FILE map ID= "_VUID
QUIT
+12 SET IEN=+Y
SET RECORD("NEW")=1
+13 ;
+14 QUIT
+15 ;
ZRT ;
+1 ;
+2 IF $GET(NAME)="EffectiveDate"
DO STATUS
QUIT
+3 IF $GET(NAME)="MapDefinition"
DO MAPDEF
QUIT
+4 ;
+5 QUIT
+6 ;
STATUS ;
+1 ;
+2 IF $DATA(FDA)
DO UPDATE^XUMF1H
KILL FDA
+3 ;
+4 NEW VALUE,FDA
+5 ;
+6 SET VALUE=$$UNESC^XUMF0($PIECE(HLNODE,HLFS,3),.HL)
+7 SET VALUE=$$DTYP^XUMFXP(VALUE,"DT",HLCS,0,"L")
+8 ;
+9 ;S IEN1=$O(^LEX(757.33,2485,2,99999),-1),IEN1=IEN1+1
+10 ;
+11 KILL FDA
+12 SET FDA(757.333,"?+1,"_IEN_",",.01)=VALUE
+13 ;
+14 XECUTE HLNEXT
IF HLQUIT'>0
SET ERROR="1^status error"
QUIT
+15 ;
+16 IF $PIECE(HLNODE,HLFS,2)'="Active"
SET ERROR="1^status error"
QUIT
+17 SET VALUE=$$UNESC^XUMF0($PIECE(HLNODE,HLFS,3),.HL)
+18 SET VALUE=$$DTYP^XUMFXP(VALUE,"ST",HLCS,0)
+19 ;
+20 SET FDA(757.333,"?+1,"_IEN_",",1)=$SELECT(VALUE:"ACTIVE",1:"INACTIVE")
+21 ;
+22 DO UPDATE^DIE("E","FDA",,"ERR")
+23 IF $DATA(ERR)
Begin DoDot:1
+24 SET ERROR="1^status update error"
+25 DO EM^XUMF1H(ERROR,.ERR)
KILL ERR
End DoDot:1
QUIT
+26 ;
+27 SET OUT=1
+28 ;
+29 QUIT
+30 ;
MAPDEF ;
+1 ;
+2 NEW VALUE,IENS
+3 ;
+4 SET IENS=IEN_","
+5 SET VALUE=$$UNESC^XUMF0($PIECE(HLNODE,HLFS,3),.HL)
+6 SET VALUE=$ORDER(^LEX(757.32,"C",VALUE,0))
+7 SET FDA(IFN,IENS,.02)=VALUE
+8 SET OUT=1
+9 ;
+10 QUIT
+11 ;
STAT() ;
+1 ;
+2 NEW X
+3 SET X=$ORDER(^LEX(757.33,IEN,2,999),-1)
if 'X
QUIT ""
+4 QUIT $PIECE($GET(^LEX(757.33,IEN,2,X,0)),U,2)
+5 ;
