1 | MCNP2X ;HIRMFO/DAD-NEW PERSON CONVERSION FILE XREF ;5/8/96 09:17
|
---|
2 | ;;2.3;Medicine;;09/13/1996
|
---|
3 | ;
|
---|
4 | XREF(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
|
---|