source: FOIAVistA/trunk/r/MEDICINE-MC/MCNP2X.m@ 1389

Last change on this file since 1389 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 985 bytes
Line 
1MCNP2X ;HIRMFO/DAD-NEW PERSON CONVERSION FILE XREF ;5/8/96 09:17
2 ;;2.3;Medicine;;09/13/1996
3 ;
4XREF(MCD0,MCX,MCPIECE,MCACTION) ; *** AA/AB Xref set / kill logic
5 ; MCD0 = file (#690.99) IEN
6 ; MCX = The value of the field
7 ; MCPIECE = The piece position of the field
8 ; MCACTION = Xref action (S - Set, K - Kill)
9 ;
10 N MCZERO,MCFIL,MCFLD,MCSUB,MCIEN
11 S MCZERO=$G(^MCAR(690.99,+MCD0,0))
12 S MCFIL=$S(MCPIECE=4:MCX,1:$P(MCZERO,U,4))
13 S MCFLD=$S(MCPIECE=3:MCX,1:$P(MCZERO,U,3))
14 S MCSUB=$S(MCPIECE=2:MCX,1:$P(MCZERO,U,2))
15 S MCIEN=$S(MCPIECE=1:MCX,1:$P(MCZERO,U,1))
16 I (MCFIL="")!(MCFLD="")!(MCIEN="") Q
17 I MCFIL=700,MCFLD=21 D
18 . I MCSUB="" Q
19 . I MCACTION="S" D
20 .. S ^MCAR(690.99,"AB",MCFIL,MCFLD,MCIEN,MCSUB,MCD0)=""
21 .. Q
22 . I MCACTION="K" D
23 .. K ^MCAR(690.99,"AB",MCFIL,MCFLD,MCIEN,MCSUB,MCD0)
24 .. Q
25 . Q
26 E D
27 . I MCACTION="S" D
28 .. S ^MCAR(690.99,"AA",MCFIL,MCFLD,MCIEN,MCD0)=""
29 .. Q
30 . I MCACTION="K" D
31 .. K ^MCAR(690.99,"AA",MCFIL,MCFLD,MCIEN,MCD0)
32 .. Q
33 . Q
34 Q
Note: See TracBrowser for help on using the repository browser.