- 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 ---[H[J[2J[HPRSALIB 1531 printed Feb 18, 2025@23:49:59 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