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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCNP2X 1019 printed Dec 13, 2024@02:15:17 Page 2
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
