source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNDIV.m

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1SPNDIV ;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 ;
7EN(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
25LOAD(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
Note: See TracBrowser for help on using the repository browser.