source: WorldVistAEHR/trunk/r/PAID-PRS/PRSDMISC.m@ 836

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

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1PRSDMISC ;HISC/MGD-PAID MISCELLANEOUS SUB-ROUTINES ;09/13/2003
2 ;;4.0;PAID;**82**;Sep 21, 1995
3SEPIND ;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
19ACCSEP ;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
Note: See TracBrowser for help on using the repository browser.