source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNFSRV2.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1SPNFSRV2 ;HISC/DAD-SCD REGISTRY VETERAN SURVEY SERVER ;7/17/95 10:04
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ;
4FIM ; *** 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 ;
42STATION(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
Note: See TracBrowser for help on using the repository browser.