VistA-WorldVistAEHR/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNFSRV1.m

70 lines
2.2 KiB
Mathematica

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