51 lines
1.6 KiB
Mathematica
51 lines
1.6 KiB
Mathematica
|
SPNFSRV2 ;HISC/DAD-SCD REGISTRY VETERAN SURVEY SERVER ;7/17/95 10:04
|
||
|
|
;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
||
|
|
;
|
||
|
|
FIM ; *** FIM data
|
||
|
|
S X=$G(SPNFDATA(0)),SPNFFTYP=$P(X,U,2),SPNFDATE=$P(X,U,4)
|
||
|
|
I (SPNFFTYP="")!(SPNFDATE="") Q
|
||
|
|
S SPNFFIMC=SPNFFIMC+1
|
||
|
|
S SPND0=+$O(^SPNL(154.1,"AA",SPNFFTYP,SPNFDFN,SPNFDATE,0))
|
||
|
|
I (SPND0'>0)!($P($G(^SPNL(154.1,SPND0,0)),U)'=SPNFDFN) D
|
||
|
|
. K DD,DIC,DINUM,DO
|
||
|
|
. S DIC="^SPNL(154.1,",DIC(0)="L",DLAYGO=154.1,X=SPNFDFN
|
||
|
|
. D FILE^DICN
|
||
|
|
. S SPND0=+Y
|
||
|
|
. K DA,DIE,DR
|
||
|
|
. S DIE="^SPNL(154.1,",DA=SPND0
|
||
|
|
. S DR=".02///"_SPNFFTYP_";.04///"_SPNFDATE
|
||
|
|
. D ^DIE
|
||
|
|
. Q
|
||
|
|
K DR S SPNDR=0
|
||
|
|
S SPNFFLDS=".01^^.03^^.05^.06^.07^.08^.09^.1^.11^.12^.13^.14^.15^.16^.17^.18^.19^.2^.21^.22"
|
||
|
|
F SPNPIECE=2:1:$L($G(SPNFDATA(0))) D
|
||
|
|
. I $P(SPNFFLDS,U,SPNPIECE)="" Q
|
||
|
|
. S SPNX=$P(SPNFDATA(0),U,SPNPIECE) Q:SPNX=""
|
||
|
|
. S SPNDR=SPNDR+1
|
||
|
|
. S DR(1,154.1,SPNDR)=$P(SPNFFLDS,U,SPNPIECE)_"///"_SPNX
|
||
|
|
. Q
|
||
|
|
;
|
||
|
|
S SPNFFLDS="2.01^2.02^2.03^2.04^2.05^2.06^2.07^2.08^2.09^2.1^"
|
||
|
|
F SPNPIECE=1:1:$L($G(SPNFDATA(2))) D
|
||
|
|
. I $P(SPNFFLDS,U,SPNPIECE)="" Q
|
||
|
|
. S SPNX=$P(SPNFDATA(2),U,SPNPIECE) Q:SPNX=""
|
||
|
|
. S SPNDR=SPNDR+1
|
||
|
|
. S DR(1,154.1,SPNDR)=$P(SPNFFLDS,U,SPNPIECE)_"///"_SPNX
|
||
|
|
. Q
|
||
|
|
S SPNFSTAT(1)=$$STATION($P($G(SPNFDATA(2)),U,11))
|
||
|
|
I SPNFSTAT(1) S SPNDR=SPNDR+1,DR(1,154.1,SPNDR)="2.11///`"_SPNFSTAT(1)
|
||
|
|
S SPNFSTAT(2)=$$STATION($P($G(SPNFDATA(2)),U,12))
|
||
|
|
I SPNFSTAT(2) S SPNDR=SPNDR+1,DR(1,154.1,SPNDR)="2.12///`"_SPNFSTAT(2)
|
||
|
|
I SPNDR K DA,DIE S DIE="^SPNL(154.1,",DA=SPND0,DR="" D ^DIE
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
STATION(X) ; *** Find station IEN
|
||
|
|
; X = Station number
|
||
|
|
N D0
|
||
|
|
I X]"" D
|
||
|
|
. S D0=+$O(^DIC(4,"D",X,0))
|
||
|
|
. I X'=$P($G(^DIC(4,D0,99)),U) S D0=0
|
||
|
|
. Q
|
||
|
|
E S D0=0
|
||
|
|
Q D0
|