source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNFSRV1.m@ 841

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1SPNFSRV1 ;HISC/DAD-SCD REGISTRY VETERAN SURVEY SERVER ;1/8/96 11:01
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ;
4REG ; *** Registration data
5 S SPNFREGC=SPNFREGC+1
6 S SPND0=+$O(^SPNL(154,"B",SPNFDFN,0))
7 I (SPND0'>0)!($P($G(^SPNL(154,SPND0,0)),U)'=SPNFDFN) D
8 . K DD,DIC,DINUM,DO
9 . S DIC="^SPNL(154,",DIC(0)="L",DLAYGO=154,(DINUM,X)=SPNFDFN
10 . D FILE^DICN
11 . S SPND0=+Y
12 . Q
13 K DR S SPNDR=0
14 S SPNFFLDS=".01^.02^.03^.04^.05"
15 F SPNPIECE=2:1:$L($G(SPNFDATA(0))) D
16 . S SPNX=$P(SPNFDATA(0),U,SPNPIECE) Q:SPNX=""
17 . S SPNDR=SPNDR+1
18 . S DR(1,154,SPNDR)=$P(SPNFFLDS,U,SPNPIECE)_"///"_SPNX
19 . Q
20 S SPNFFLDS="2.1^2.2^2.3^2.4^2.5"
21 F SPNPIECE=1:1:$L($G(SPNFDATA(2))) D
22 . S SPNX=$P(SPNFDATA(2),U,SPNPIECE) Q:SPNX=""
23 . S SPNDR=SPNDR+1
24 . S DR(1,154,SPNDR)=$P(SPNFFLDS,U,SPNPIECE)_"///"_SPNX
25 . Q
26 S SPNETIOL=$$ETIOLOGY($P($G(SPNFDATA(5)),U))
27 I SPNETIOL S SPNDR=SPNDR+1,DR(1,154,SPNDR)="5.01///`"_SPNETIOL
28 S SPNFFLDS="5.01^5.02^5.03^5.04^5.05^5.06^5.07^5.08^5.09^5.1^5.11^5.12"
29 F SPNPIECE=2:1:$L($G(SPNFDATA(5))) D
30 . S SPNX=$P(SPNFDATA(5),U,SPNPIECE) Q:SPNX=""
31 . S SPNDR=SPNDR+1
32 . S DR(1,154,SPNDR)=$P(SPNFFLDS,U,SPNPIECE)_"///"_SPNX
33 . Q
34 I SPNDR K DA,DIE S DIE="^SPNL(154,",DA=SPND0,DR="" D ^DIE
35 ;
36 S SPNONSET=0
37 F S SPNONSET=$O(SPNFDATA("E",SPNONSET)) Q:SPNONSET'>0 D
38 . S SPNDATE=$P(SPNFDATA("E",SPNONSET),U) Q:SPNDATE'>0
39 . S SPNETIOL=$$ETIOLOGY($P(SPNFDATA("E",SPNONSET),U,2))
40 . S SPNOTHER=$P(SPNFDATA("E",SPNONSET),U,3)
41 . S SPND1=+$O(^SPNL(154,SPND0,"E","B",SPNDATE,0))
42 . I SPND1'>0 D
43 .. K DA,DD,DIC,DINUM,DO
44 .. S DIC="^SPNL(154,"_SPND0_",""E"",",DIC(0)="L",DLAYGO=154.004
45 .. S DIC("P")=$P(^DD(154,4,0),U,2),(D0,DA(1))=SPND0,X=SPNDATE
46 .. D FILE^DICN
47 .. S SPND1=+Y
48 .. Q
49 . I SPNETIOL D
50 .. K DA,DIE,DR
51 .. S DIE="^SPNL(154,"_SPND0_",""E"","
52 .. S (D0,DA(1))=SPND0,(D1,DA)=SPND1
53 .. S DR=".02///`"_SPNETIOL
54 .. I SPNOTHER]"" S DR=DR_";.03///"_SPNOTHER
55 .. D ^DIE
56 .. Q
57 . Q
58 Q
59 ;
60ETIOLOGY(X) ; *** Find etiology IEN
61 ; X = Description ; Type_of_Cause
62 N D0,DESC,IEN,TYPE
63 S DESC=$P(X,";"),TYPE=$P(X,";",2),(D0,IEN)=0
64 I DESC]"" F S D0=$O(^SPNL(154.03,"B",DESC,D0)) Q:D0'>0!IEN D
65 . S X=$G(^SPNL(154.03,D0,0))
66 . S DESC(0)=$P(X,U),TYPE(0)=$P(X,U,2)
67 . I DESC=DESC(0),TYPE=TYPE(0) S IEN=D0
68 . Q
69 Q IEN
Note: See TracBrowser for help on using the repository browser.