MCNP2X.m

MCNP2X ;HIRMFO/DAD-NEW PERSON CONVERSION FILE XREF ;5/8/96  09:17

 ;;2.3;Medicine;;09/13/1996

 ;

XREF(MCD0,MCX,MCPIECE,MCACTION) ; *** AA/AB Xref set / kill logic

 ;  MCD0    = file (#690.99) IEN

 ;  MCX    = The value of the field

 ;  MCPIECE = The piece position of the field

 ;  MCACTION = Xref action (S - Set, K - Kill)

 ;

 N MCZERO,MCFIL,MCFLD,MCSUB,MCIEN

 S MCZERO=$G(^MCAR(690.99,+MCD0,0))

 S MCFIL=$S(MCPIECE=4:MCX,1:$P(MCZERO,U,4))

 S MCFLD=$S(MCPIECE=3:MCX,1:$P(MCZERO,U,3))

 S MCSUB=$S(MCPIECE=2:MCX,1:$P(MCZERO,U,2))

 S MCIEN=$S(MCPIECE=1:MCX,1:$P(MCZERO,U,1))

 I (MCFIL="")!(MCFLD="")!(MCIEN="") Q

 I MCFIL=700,MCFLD=21 D

 . I MCSUB="" Q

 . I MCACTION="S" D

 .. S ^MCAR(690.99,"AB",MCFIL,MCFLD,MCIEN,MCSUB,MCD0)=""

 .. Q

 . I MCACTION="K" D

 .. K ^MCAR(690.99,"AB",MCFIL,MCFLD,MCIEN,MCSUB,MCD0)

 .. Q

 . Q

 E  D

 . I MCACTION="S" D

 .. S ^MCAR(690.99,"AA",MCFIL,MCFLD,MCIEN,MCD0)=""

 .. Q

 . I MCACTION="K" D

 .. K ^MCAR(690.99,"AA",MCFIL,MCFLD,MCIEN,MCD0)

 .. Q

 . Q

 Q

MCNP2X    ;HIRMFO/DAD-NEW PERSON CONVERSION FILE XREF ;5/8/96  09:17

 +1       ;;2.3;Medicine;;09/13/1996

 +2       ;

XREF(MCD0,MCX,MCPIECE,MCACTION) ; *** AA/AB Xref set / kill logic

 +1       ;  MCD0    = file (#690.99) IEN

 +2       ;  MCX    = The value of the field

 +3       ;  MCPIECE = The piece position of the field

 +4       ;  MCACTION = Xref action (S - Set, K - Kill)

 +5       ;

 +6        NEW MCZERO,MCFIL,MCFLD,MCSUB,MCIEN

 +7        SET MCZERO=$GET(^MCAR(690.99,+MCD0,0))

 +8        SET MCFIL=$SELECT(MCPIECE=4:MCX,1:$PIECE(MCZERO,U,4))

 +9        SET MCFLD=$SELECT(MCPIECE=3:MCX,1:$PIECE(MCZERO,U,3))

 +10       SET MCSUB=$SELECT(MCPIECE=2:MCX,1:$PIECE(MCZERO,U,2))

 +11       SET MCIEN=$SELECT(MCPIECE=1:MCX,1:$PIECE(MCZERO,U,1))

 +12       IF (MCFIL="")!(MCFLD="")!(MCIEN="")

               QUIT 

 +13       IF MCFIL=700

               IF MCFLD=21

                   Begin DoDot:1

 +14                   IF MCSUB=""

                           QUIT 

 +15                   IF MCACTION="S"

                           Begin DoDot:2

 +16                           SET ^MCAR(690.99,"AB",MCFIL,MCFLD,MCIEN,MCSUB,MCD0)=""

 +17                           QUIT 

                           End DoDot:2

 +18                   IF MCACTION="K"

                           Begin DoDot:2

 +19                           KILL ^MCAR(690.99,"AB",MCFIL,MCFLD,MCIEN,MCSUB,MCD0)

 +20                           QUIT 

                           End DoDot:2

 +21                   QUIT 

                   End DoDot:1

 +22      IF '$TEST

               Begin DoDot:1

 +23               IF MCACTION="S"

                       Begin DoDot:2

 +24                       SET ^MCAR(690.99,"AA",MCFIL,MCFLD,MCIEN,MCD0)=""

 +25                       QUIT 

                       End DoDot:2

 +26               IF MCACTION="K"

                       Begin DoDot:2

 +27                       KILL ^MCAR(690.99,"AA",MCFIL,MCFLD,MCIEN,MCD0)

 +28                       QUIT 

                       End DoDot:2

 +29               QUIT 

               End DoDot:1

 +30       QUIT