PRSDMISC.m

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 ---PRSDMISC   1122     printed  Apr 09, 2024@21:30:41                                                                                                                                                                                                    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