1 | PRSDMISC ;HISC/MGD-PAID MISCELLANEOUS SUB-ROUTINES ;09/13/2003
|
---|
2 | ;;4.0;PAID;**82**;Sep 21, 1995
|
---|
3 | SEPIND ;Separation Ind
|
---|
4 | S SEPNAME=$P(^PRSPC(IEN,0),U,1),TL=$P(^PRSPC(IEN,0),U,8)
|
---|
5 | S CCORG=$P(^PRSPC(IEN,0),U,49)
|
---|
6 | S SEPIND="" S:$D(^PRSPC(IEN,1)) SEPIND=$P(^PRSPC(IEN,1),U,33)
|
---|
7 | I DATA="Y" D
|
---|
8 | .I TL'="",TYPE'="E" S $P(^PRSPC(IEN,0),U,8)="" K ^PRSPC("ATL"_TL,SEPNAME,IEN)
|
---|
9 | .I CCORG'="" K ^PRSPC("ACC",CCORG,IEN)
|
---|
10 | I DATA="N" D
|
---|
11 | .I CCORG'="" S ^PRSPC("ACC",CCORG,IEN)=""
|
---|
12 | .I TYPE="E",SEPIND="Y" D
|
---|
13 | ..I $D(^PRSPC(IEN,"ANNUAL")) F P=2,3,4,5,6,7,9,10,11,12,13,14 S $P(^PRSPC(IEN,"ANNUAL"),U,P)=""
|
---|
14 | ..I $D(^PRSPC(IEN,"LWOP")) F P=2,3,5,6,7,8,9,11 S $P(^PRSPC(IEN,"LWOP"),U,P)=""
|
---|
15 | ..K ^PRSPC(IEN,"BAYLOR"),^PRSPC(IEN,"COMP")
|
---|
16 | ..K ^PRSPC(IEN,"MILITARY"),^PRSPC(IEN,"SICK")
|
---|
17 | ..S ^TMP($J,"PRS",SEPNAME,SSN)=""
|
---|
18 | K SEPNAME,TL,CCORG,SEPIND,P Q
|
---|
19 | ACCSEP ;Accession/Separation fields
|
---|
20 | I TYPE="I",DATA="" S NODE="" Q
|
---|
21 | I TYPE="E",DATA="" S NODE="" Q
|
---|
22 | I TYPE="T",DBNAME="MBSACODE",DATA="" S DATA="A" Q
|
---|
23 | I TYPE="T",DBNAME="MBSADATE",DATA="" S DATA=$P(^PRSPC(IEN,0),"^",3) Q
|
---|
24 | I TYPE="T",DBNAME="MBSANOAC",DATA="" S DATA="ACC" Q
|
---|