PRSALIB.m

PRSALIB ;WIRMFO-JAH    LIBRARY OF SCOPED FUNCTIONS AND PROCEDURES;

 ;;4.0;PAID;**11**;Sep 21, 1995

 Q

 ;must enter thru a function or procedure call

 ;

PERM(PPI,DFN) ;JAHeiges- check DAY multiple, temp tour field, 4 perm status

 ;return true if all are permanent false otherwise

 N DAY S RTN=1

 F DAY=1:1:14 I $P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",3)'=0 S RTN=0

 Q RTN

TMPST(TYPE) ;JAHeiges-Ask tour type. (Return TYP: 0=temp,1=perm)

 ; (function returns 0 if status question not answered, else true)

 W ! N DIR,DIRUT

 S DIR("A",1)="Is this tour PERMANANT."

 S DIR("A")="Should this tour automatically move to future pay periods"

 S DIR(0)="YO",DIR("B")="YES"

 S DIR("?")="Answer YES to ensure permanent status for this person."

 S DIR("?",1)="A permanent status enables an automatic move into "

 S DIR("?",2)="future pay periods.  Answer NO for a temporary status."

 D ^DIR

 I $D(DIRUT) S TYPE="",RTN=0

 E  S TYPE='(Y),RTN=1

 Q RTN

UPDSTAT(PPI,DFN,STAT) ;JAHeiges

 ;function loops thru DAY multiple (temp tour field) and sets status

 N DAY S RTN=1

 F DAY=1:1:14 D

 . S $P(^PRST(458,PPI,"E",DFN,"D",DAY,0),"^",3)=STAT

 Q

UPDTQ() ;JAHeiges-Ask 2 update tour status /Return 0=no 1=yes/

 N RTN,DIR,DIRUT

 S DIR("A")="Update Tour Status"

 S DIR(0)="YO",DIR("B")="YES"

 S DIR("?",1)="Answer YES to update status.  Answer NO keep current."

 S DIR("?",2)="I'll ask type of tour next, (temporary or permanent.)"

 S DIR("?")="Update tour status"

 D ^DIR

 I $D(DIRUT) S RTN=0

 E  S RTN=Y

 Q RTN

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRSALIB   1531     printed  Apr 09, 2024@21:28:22                                                                                                                                                                                                     Page 2

PRSALIB   ;WIRMFO-JAH    LIBRARY OF SCOPED FUNCTIONS AND PROCEDURES;

 +1       ;;4.0;PAID;**11**;Sep 21, 1995

 +2        QUIT 

 +3       ;must enter thru a function or procedure call

 +4       ;

PERM(PPI,DFN) ;JAHeiges- check DAY multiple, temp tour field, 4 perm status

 +1       ;return true if all are permanent false otherwise

 +2        NEW DAY

           SET RTN=1

 +3        FOR DAY=1:1:14

               IF $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",3)'=0

                   SET RTN=0

 +4        QUIT RTN

TMPST(TYPE) ;JAHeiges-Ask tour type. (Return TYP: 0=temp,1=perm)

 +1       ; (function returns 0 if status question not answered, else true)

 +2        WRITE !

           NEW DIR,DIRUT

 +3        SET DIR("A",1)="Is this tour PERMANANT."

 +4        SET DIR("A")="Should this tour automatically move to future pay periods"

 +5        SET DIR(0)="YO"

           SET DIR("B")="YES"

 +6        SET DIR("?")="Answer YES to ensure permanent status for this person."

 +7        SET DIR("?",1)="A permanent status enables an automatic move into "

 +8        SET DIR("?",2)="future pay periods.  Answer NO for a temporary status."

 +9        DO ^DIR

 +10       IF $DATA(DIRUT)

               SET TYPE=""

               SET RTN=0

 +11      IF '$TEST

               SET TYPE='(Y)

               SET RTN=1

 +12       QUIT RTN

UPDSTAT(PPI,DFN,STAT) ;JAHeiges

 +1       ;function loops thru DAY multiple (temp tour field) and sets status

 +2        NEW DAY

           SET RTN=1

 +3        FOR DAY=1:1:14

               Begin DoDot:1

 +4                SET $PIECE(^PRST(458,PPI,"E",DFN,"D",DAY,0),"^",3)=STAT

               End DoDot:1

 +5        QUIT 

UPDTQ()   ;JAHeiges-Ask 2 update tour status /Return 0=no 1=yes/

 +1        NEW RTN,DIR,DIRUT

 +2        SET DIR("A")="Update Tour Status"

 +3        SET DIR(0)="YO"

           SET DIR("B")="YES"

 +4        SET DIR("?",1)="Answer YES to update status.  Answer NO keep current."

 +5        SET DIR("?",2)="I'll ask type of tour next, (temporary or permanent.)"

 +6        SET DIR("?")="Update tour status"

 +7        DO ^DIR

 +8        IF $DATA(DIRUT)

               SET RTN=0

 +9       IF '$TEST

               SET RTN=Y

 +10       QUIT RTN