[613] | 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
|
---|