XUMF502.m

XUMF502 ;RAM - XUMF502 ;04/15/02 ;9/10/08  11:55

 ;;8.0;KERNEL;**502**;Jul 10, 1995;Build 18

 ;

 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)

 ;

XUMF502   ;RAM - XUMF502 ;04/15/02 ;9/10/08  11:55

 +1       ;;8.0;KERNEL;**502**;Jul 10, 1995;Build 18

 +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       ;