SPNFSRV1 ;HISC/DAD-SCD REGISTRY VETERAN SURVEY SERVER ;1/8/96  11:01
 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
 ;
REG ; *** Registration data
 S SPNFREGC=SPNFREGC+1
 S SPND0=+$O(^SPNL(154,"B",SPNFDFN,0))
 I (SPND0'>0)!($P($G(^SPNL(154,SPND0,0)),U)'=SPNFDFN) D
 . K DD,DIC,DINUM,DO
 . S DIC="^SPNL(154,",DIC(0)="L",DLAYGO=154,(DINUM,X)=SPNFDFN
 . D FILE^DICN
 . S SPND0=+Y
 . Q
 K DR S SPNDR=0
 S SPNFFLDS=".01^.02^.03^.04^.05"
 F SPNPIECE=2:1:$L($G(SPNFDATA(0))) D
 . S SPNX=$P(SPNFDATA(0),U,SPNPIECE) Q:SPNX=""
 . S SPNDR=SPNDR+1
 . S DR(1,154,SPNDR)=$P(SPNFFLDS,U,SPNPIECE)_"///"_SPNX
 . Q
 S SPNFFLDS="2.1^2.2^2.3^2.4^2.5"
 F SPNPIECE=1:1:$L($G(SPNFDATA(2))) D
 . S SPNX=$P(SPNFDATA(2),U,SPNPIECE) Q:SPNX=""
 . S SPNDR=SPNDR+1
 . S DR(1,154,SPNDR)=$P(SPNFFLDS,U,SPNPIECE)_"///"_SPNX
 . Q
 S SPNETIOL=$$ETIOLOGY($P($G(SPNFDATA(5)),U))
 I SPNETIOL S SPNDR=SPNDR+1,DR(1,154,SPNDR)="5.01///`"_SPNETIOL
 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"
 F SPNPIECE=2:1:$L($G(SPNFDATA(5))) D
 . S SPNX=$P(SPNFDATA(5),U,SPNPIECE) Q:SPNX=""
 . S SPNDR=SPNDR+1
 . S DR(1,154,SPNDR)=$P(SPNFFLDS,U,SPNPIECE)_"///"_SPNX
 . Q
 I SPNDR K DA,DIE S DIE="^SPNL(154,",DA=SPND0,DR="" D ^DIE
 ;
 S SPNONSET=0
 F  S SPNONSET=$O(SPNFDATA("E",SPNONSET)) Q:SPNONSET'>0  D
 . S SPNDATE=$P(SPNFDATA("E",SPNONSET),U) Q:SPNDATE'>0
 . S SPNETIOL=$$ETIOLOGY($P(SPNFDATA("E",SPNONSET),U,2))
 . S SPNOTHER=$P(SPNFDATA("E",SPNONSET),U,3)
 . S SPND1=+$O(^SPNL(154,SPND0,"E","B",SPNDATE,0))
 . I SPND1'>0 D
 .. K DA,DD,DIC,DINUM,DO
 .. S DIC="^SPNL(154,"_SPND0_",""E"",",DIC(0)="L",DLAYGO=154.004
 .. S DIC("P")=$P(^DD(154,4,0),U,2),(D0,DA(1))=SPND0,X=SPNDATE
 .. D FILE^DICN
 .. S SPND1=+Y
 .. Q
 . I SPNETIOL D
 .. K DA,DIE,DR
 .. S DIE="^SPNL(154,"_SPND0_",""E"","
 .. S (D0,DA(1))=SPND0,(D1,DA)=SPND1
 .. S DR=".02///`"_SPNETIOL
 .. I SPNOTHER]"" S DR=DR_";.03///"_SPNOTHER
 .. D ^DIE
 .. Q
 . Q
 Q
 ;
ETIOLOGY(X) ; *** Find etiology IEN
 ;  X = Description ; Type_of_Cause
 N D0,DESC,IEN,TYPE
 S DESC=$P(X,";"),TYPE=$P(X,";",2),(D0,IEN)=0
 I DESC]"" F  S D0=$O(^SPNL(154.03,"B",DESC,D0)) Q:D0'>0!IEN  D
 . S X=$G(^SPNL(154.03,D0,0))
 . S DESC(0)=$P(X,U),TYPE(0)=$P(X,U,2)
 . I DESC=DESC(0),TYPE=TYPE(0) S IEN=D0
 . Q
 Q IEN