1 | SPNFSRV2 ;HISC/DAD-SCD REGISTRY VETERAN SURVEY SERVER ;7/17/95 10:04
|
---|
2 | ;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
---|
3 | ;
|
---|
4 | FIM ; *** FIM data
|
---|
5 | S X=$G(SPNFDATA(0)),SPNFFTYP=$P(X,U,2),SPNFDATE=$P(X,U,4)
|
---|
6 | I (SPNFFTYP="")!(SPNFDATE="") Q
|
---|
7 | S SPNFFIMC=SPNFFIMC+1
|
---|
8 | S SPND0=+$O(^SPNL(154.1,"AA",SPNFFTYP,SPNFDFN,SPNFDATE,0))
|
---|
9 | I (SPND0'>0)!($P($G(^SPNL(154.1,SPND0,0)),U)'=SPNFDFN) D
|
---|
10 | . K DD,DIC,DINUM,DO
|
---|
11 | . S DIC="^SPNL(154.1,",DIC(0)="L",DLAYGO=154.1,X=SPNFDFN
|
---|
12 | . D FILE^DICN
|
---|
13 | . S SPND0=+Y
|
---|
14 | . K DA,DIE,DR
|
---|
15 | . S DIE="^SPNL(154.1,",DA=SPND0
|
---|
16 | . S DR=".02///"_SPNFFTYP_";.04///"_SPNFDATE
|
---|
17 | . D ^DIE
|
---|
18 | . Q
|
---|
19 | K DR S SPNDR=0
|
---|
20 | S SPNFFLDS=".01^^.03^^.05^.06^.07^.08^.09^.1^.11^.12^.13^.14^.15^.16^.17^.18^.19^.2^.21^.22"
|
---|
21 | F SPNPIECE=2:1:$L($G(SPNFDATA(0))) D
|
---|
22 | . I $P(SPNFFLDS,U,SPNPIECE)="" Q
|
---|
23 | . S SPNX=$P(SPNFDATA(0),U,SPNPIECE) Q:SPNX=""
|
---|
24 | . S SPNDR=SPNDR+1
|
---|
25 | . S DR(1,154.1,SPNDR)=$P(SPNFFLDS,U,SPNPIECE)_"///"_SPNX
|
---|
26 | . Q
|
---|
27 | ;
|
---|
28 | S SPNFFLDS="2.01^2.02^2.03^2.04^2.05^2.06^2.07^2.08^2.09^2.1^"
|
---|
29 | F SPNPIECE=1:1:$L($G(SPNFDATA(2))) D
|
---|
30 | . I $P(SPNFFLDS,U,SPNPIECE)="" Q
|
---|
31 | . S SPNX=$P(SPNFDATA(2),U,SPNPIECE) Q:SPNX=""
|
---|
32 | . S SPNDR=SPNDR+1
|
---|
33 | . S DR(1,154.1,SPNDR)=$P(SPNFFLDS,U,SPNPIECE)_"///"_SPNX
|
---|
34 | . Q
|
---|
35 | S SPNFSTAT(1)=$$STATION($P($G(SPNFDATA(2)),U,11))
|
---|
36 | I SPNFSTAT(1) S SPNDR=SPNDR+1,DR(1,154.1,SPNDR)="2.11///`"_SPNFSTAT(1)
|
---|
37 | S SPNFSTAT(2)=$$STATION($P($G(SPNFDATA(2)),U,12))
|
---|
38 | I SPNFSTAT(2) S SPNDR=SPNDR+1,DR(1,154.1,SPNDR)="2.12///`"_SPNFSTAT(2)
|
---|
39 | I SPNDR K DA,DIE S DIE="^SPNL(154.1,",DA=SPND0,DR="" D ^DIE
|
---|
40 | Q
|
---|
41 | ;
|
---|
42 | STATION(X) ; *** Find station IEN
|
---|
43 | ; X = Station number
|
---|
44 | N D0
|
---|
45 | I X]"" D
|
---|
46 | . S D0=+$O(^DIC(4,"D",X,0))
|
---|
47 | . I X'=$P($G(^DIC(4,D0,99)),U) S D0=0
|
---|
48 | . Q
|
---|
49 | E S D0=0
|
---|
50 | Q D0
|
---|