PRSDMISC ;HISC/MGD-PAID MISCELLANEOUS SUB-ROUTINES ;09/13/2003
;;4.0;PAID;**82**;Sep 21, 1995
SEPIND ;Separation Ind
S SEPNAME=$P(^PRSPC(IEN,0),U,1),TL=$P(^PRSPC(IEN,0),U,8)
S CCORG=$P(^PRSPC(IEN,0),U,49)
S SEPIND="" S:$D(^PRSPC(IEN,1)) SEPIND=$P(^PRSPC(IEN,1),U,33)
I DATA="Y" D
.I TL'="",TYPE'="E" S $P(^PRSPC(IEN,0),U,8)="" K ^PRSPC("ATL"_TL,SEPNAME,IEN)
.I CCORG'="" K ^PRSPC("ACC",CCORG,IEN)
I DATA="N" D
.I CCORG'="" S ^PRSPC("ACC",CCORG,IEN)=""
.I TYPE="E",SEPIND="Y" D
..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)=""
..I $D(^PRSPC(IEN,"LWOP")) F P=2,3,5,6,7,8,9,11 S $P(^PRSPC(IEN,"LWOP"),U,P)=""
..K ^PRSPC(IEN,"BAYLOR"),^PRSPC(IEN,"COMP")
..K ^PRSPC(IEN,"MILITARY"),^PRSPC(IEN,"SICK")
..S ^TMP($J,"PRS",SEPNAME,SSN)=""
K SEPNAME,TL,CCORG,SEPIND,P Q
ACCSEP ;Accession/Separation fields
I TYPE="I",DATA="" S NODE="" Q
I TYPE="E",DATA="" S NODE="" Q
I TYPE="T",DBNAME="MBSACODE",DATA="" S DATA="A" Q
I TYPE="T",DBNAME="MBSADATE",DATA="" S DATA=$P(^PRSPC(IEN,0),"^",3) Q
I TYPE="T",DBNAME="MBSANOAC",DATA="" S DATA="ACC" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDMISC 1122 printed Dec 13, 2024@02:25:46 Page 2
PRSDMISC ;HISC/MGD-PAID MISCELLANEOUS SUB-ROUTINES ;09/13/2003
+1 ;;4.0;PAID;**82**;Sep 21, 1995
SEPIND ;Separation Ind
+1 SET SEPNAME=$PIECE(^PRSPC(IEN,0),U,1)
SET TL=$PIECE(^PRSPC(IEN,0),U,8)
+2 SET CCORG=$PIECE(^PRSPC(IEN,0),U,49)
+3 SET SEPIND=""
if $DATA(^PRSPC(IEN,1))
SET SEPIND=$PIECE(^PRSPC(IEN,1),U,33)
+4 IF DATA="Y"
Begin DoDot:1
+5 IF TL'=""
IF TYPE'="E"
SET $PIECE(^PRSPC(IEN,0),U,8)=""
KILL ^PRSPC("ATL"_TL,SEPNAME,IEN)
+6 IF CCORG'=""
KILL ^PRSPC("ACC",CCORG,IEN)
End DoDot:1
+7 IF DATA="N"
Begin DoDot:1
+8 IF CCORG'=""
SET ^PRSPC("ACC",CCORG,IEN)=""
+9 IF TYPE="E"
IF SEPIND="Y"
Begin DoDot:2
+10 IF $DATA(^PRSPC(IEN,"ANNUAL"))
FOR P=2,3,4,5,6,7,9,10,11,12,13,14
SET $PIECE(^PRSPC(IEN,"ANNUAL"),U,P)=""
+11 IF $DATA(^PRSPC(IEN,"LWOP"))
FOR P=2,3,5,6,7,8,9,11
SET $PIECE(^PRSPC(IEN,"LWOP"),U,P)=""
+12 KILL ^PRSPC(IEN,"BAYLOR"),^PRSPC(IEN,"COMP")
+13 KILL ^PRSPC(IEN,"MILITARY"),^PRSPC(IEN,"SICK")
+14 SET ^TMP($JOB,"PRS",SEPNAME,SSN)=""
End DoDot:2
End DoDot:1
+15 KILL SEPNAME,TL,CCORG,SEPIND,P
QUIT
ACCSEP ;Accession/Separation fields
+1 IF TYPE="I"
IF DATA=""
SET NODE=""
QUIT
+2 IF TYPE="E"
IF DATA=""
SET NODE=""
QUIT
+3 IF TYPE="T"
IF DBNAME="MBSACODE"
IF DATA=""
SET DATA="A"
QUIT
+4 IF TYPE="T"
IF DBNAME="MBSADATE"
IF DATA=""
SET DATA=$PIECE(^PRSPC(IEN,0),"^",3)
QUIT
+5 IF TYPE="T"
IF DBNAME="MBSANOAC"
IF DATA=""
SET DATA="ACC"
QUIT
