- 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 Mar 13, 2025@21:30:48 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
