1 | SPNDIV ;WDE/SAN-DIEGO;Build the station number in 154
|
---|
2 | ;;2.0;Spinal Cord Dysfunction;**15**;01/02/97
|
---|
3 | ;this routine is called from spnfedt1
|
---|
4 | ;and can be called from any place that is needed to set
|
---|
5 | ;up the station number in the 154.
|
---|
6 | ;
|
---|
7 | EN(SPNLD0) ;The record number in 154. Same as dpt
|
---|
8 | S SPNTEST=0
|
---|
9 | S SPNTD=0,SPNTD=$P($G(^SPNL(154.91,1,1,DUZ,0)),U,2) Q:SPNTD=""
|
---|
10 | S SPNTDIV="" S SPNTDIV=$O(^DG(40.8,"C",SPNTD,SPNTDIV))
|
---|
11 | ;S SPNTEST=$G(^SPNL(154,SPNLD0,4,SPNDIV,0))
|
---|
12 | ;if suffix is on file quit
|
---|
13 | I $D(^SPNL(154,SPNLD0,4,"B",SPNTDIV)) K SPNTEST,SPNTD,SPNDIV Q
|
---|
14 | I SPNTEST K SPNTEST Q
|
---|
15 | S DIC="^SPNL(154,"
|
---|
16 | K D0
|
---|
17 | S DA(1)=SPNLD0
|
---|
18 | S DIC=DIC_DA(1)_",4,"
|
---|
19 | S DIC(0)="L"
|
---|
20 | S DIC("P")=$P(^DD(154,12,0),"^",2)
|
---|
21 | S X=SPNTDIV
|
---|
22 | D ^DIC
|
---|
23 | K SPNTEST,SPNTDIV,DIC,DA,SPNTD,DA,DIC
|
---|
24 | Q
|
---|
25 | LOAD(DUZ) ;
|
---|
26 | ;This line tag can be used to stuff the assigned Medical Center Division
|
---|
27 | ;into a record based on the value that the user has selected and
|
---|
28 | ;looking at the sci coord & last updated by fields
|
---|
29 | ;if the duz matches either one of the fields the medical center division
|
---|
30 | ;is inserted into the record.
|
---|
31 | S SPNVALU=$G(^SPNL(154.91,1,1,DUZ,0)),SPNVALU=$P(SPNVALU,U,4)
|
---|
32 | I SPNVALU="Y" K SPNVALU Q ;UPDATE HAS RAN FOR THIS USER
|
---|
33 | S SPNVALU=""
|
---|
34 | S SPNTEMP=$P($G(^SPNL(154.91,1,1,DUZ,0)),U,2)
|
---|
35 | S SPNVALU=$O(^DG(40.8,"C",SPNTEMP,SPNVALU))
|
---|
36 | Q:$D(SPNVALU)=0 Q:SPNVALU=""
|
---|
37 | S $P(^SPNL(154.91,1,1,DUZ,0),U,4)="Y"
|
---|
38 | W !,"Please stand by while your Registry is updated.",!
|
---|
39 | S SPNLD0=0 F S SPNLD0=$O(^SPNL(154,SPNLD0)) Q:(SPNLD0=0)!('+SPNLD0) D
|
---|
40 | .S SPNTST1=$G(^SPNL(154,SPNLD0,0)),SPNTST1=$P(SPNTST1,U,6)
|
---|
41 | .S SPNTST2=$G(^SPNL(154,SPNLD0,"CARE")),SPNTST2=$P(SPNTST2,U,2)
|
---|
42 | .I (SPNTST1=DUZ)!(SPNTST2=DUZ) D
|
---|
43 | ..S DIC="^SPNL(154,"
|
---|
44 | ..S DIC(1)=SPNLD0
|
---|
45 | ..S DIC=DIC_DIC(1)_",4,"
|
---|
46 | ..S DIC(0)="QL"
|
---|
47 | ..S DIC("P")=$P(^DD(154,12,0),"^",2)
|
---|
48 | ..S DA(1)=SPNLD0
|
---|
49 | ..K DD
|
---|
50 | ..S X=SPNVALU
|
---|
51 | ..I $D(^SPNL(154,SPNLD0,4,"B",SPNVALU)) Q
|
---|
52 | ..D FILE^DICN
|
---|
53 | ..Q
|
---|
54 | W !,"Thank you!!",!
|
---|
55 | K DIC,DA,DR,SPNLD0,SPNVALU,SPNTST1,SPNTST2,SPNTEMP
|
---|
56 | Q
|
---|