- PRSATP ;HISC/REL,WIRMFO/MGD/PLT - Timekeeper Post Time ;4/13/2012
- ;;4.0;PAID;**22,57,69,92,102,93,112,126,132,137**;Sep 21, 1995;Build 4
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ; input (from calling option)
- ; PTPF - (optional) part-time physician flag, true (=1) when called
- ; by the posting option for part-time physicians with a memo.
- ;
- N GLOB ; global reference for employee's time & attendance record.
- N PRSDT
- S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX S %DT="X",X="T+3" D ^%DT
- S %DT="AEPX",%DT("A")="Posting Date: ",%DT("B")="T-1",%DT(0)=-Y W ! D ^%DT
- G:Y<1 EX S (PRSDT,D1)=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)
- I PPI="" W !!,$C(7),"Pay Period is Not Open Yet!" G EX
- S PPE=$P($G(^PRST(458,PPI,0)),"^",1),DTE=$P($G(^PRST(458,PPI,2)),"^",DAY),DTI=$P($G(^(1)),"^",DAY)
- D2 W !!,"Would you like to edit the T & A RECORDs in alphabetical order" S %=1 D YN^DICN I % S LP=% G EX:%=-1,LOOP:%=1,NME
- W !!,"Answer YES if you want all RECORDs brought up for which no data"
- W !,"has been entered." G D2
- ;
- ;
- LOOP ;
- S LP=1,NN=""
- F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" F DFN=0:0 S DFN=$O(^PRSPC("ATL"_TLE,NN,DFN)) Q:DFN<1 I $$PTPSCR(DFN,PRSDT,$G(PTPF)) S GLOB="" D POST D:GLOB]"" UNLOCK^PRSLIB00(GLOB),NURSEPOC^PRSNEETP(TLI,PPI,DFN,PRSDT) I 'LP G EX
- G EX
- NME K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE,$D(^PRST(458,PPI,""E"",+Y)),$$PTPSCR^PRSATP(+Y,PRSDT,$G(PTPF))",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC
- G:DFN<1 EX S GLOB="" D POST D:GLOB]"" UNLOCK^PRSLIB00(GLOB),NURSEPOC^PRSNEETP(TLI,PPI,DFN,PRSDT) G NME
- POST S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2),TC2=$P($G(^(0)),"^",13)
- I 'TC Q:LP'=2 W !!?5,"This Employee has no tour entered for this date." Q
- I "T"'[$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) W:LP=2 $C(7),!!,"This Employee has already been sent to Payroll." Q
- S STAT=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",1)
- I LP=1,"1 3 4"[TC!(STAT'="") Q
- ;
- ; check if ESR is approved when posting PT Phy with memo
- I $G(PTPF),$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,7)),U)=5 D Q:'Y!$D(DIRUT)
- . W $C(7),!
- . W !,"This day was auto-posted from an approved Electronic Subsidiary Record (ESR)."
- . W !,"Normally, changes should be accomplished by having the T & L supervisor return"
- . W !,"the ESR day to the part-time physician for correction."
- . W !,"An exception to the above is when AWOL, On Suspension, or Non-Pay must be"
- . W !,"posted, since those can not be entered via the ESR.",!
- . S DIR(0)="Y"
- . S DIR("A")="Do you want to manually post this day on the timecard"
- . S DIR("B")="NO"
- . D ^DIR K DIR
- ;
- ; lock employee record for editing by timekeeper
- I '$$AVAILREC^PRSLIB00("TK",.GLOB,.STOP) S:LP=1&$G(STOP) LP=0 Q
- D ^PRSADP1,LP,^PRSATP2,^PRSAENT
- G P0:TC>4,P0:TC=2,P0:TC=3,P3:TC=4,P1
- P0 R !!,"Did Employee Only Work Scheduled Tour? ",X:DTIME S:'$T X="^^" S:X["^^" LP=0 Q:X["^" S X=$TR(X,"yesnor","YESNOR")
- S:X="" X="*" I $P("YES",X,1)'="",$P("NO",X,1)'="",X'="R" W $C(7),!?5," Answer YES or NO or R for Normal Posting with Remarks" G P0
- S X=$E(X,1) I "YR"'[X G P1
- S PTY=1 I STAT'="" K ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3)
- I TC=3 S $P(^PRST(458,PPI,"E",DFN,"D",DAY,2),"^",3)="RG",STAT="T"
- I STAT'="",$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) D NOW^%DTC S NOW=%,TT="HW" D S0^PRSAPPH
- S LV="" D A2^PRSATP0:X="R" G UPD
- P1 R !!,"Was Employee Absent the Entire Tour? ",X:DTIME S:'$T X="^" Q:X["^" S X=$TR(X,"yesno","YESNO")
- S:X="" X="*" I $P("YES",X,1)'="",$P("NO",X,1)'="" W $C(7)," Answer YES or NO" G P1
- I X?1"Y".E D ^PRSATP0 Q:X["^" G UPD
- ;
- ;for daily employees if you say they didn't work and they were not absent
- ;then effectively you have not created any posting for the day and we
- ;clean up any prior posting
- I $E(ENT,1,2)["D" D Q
- . K ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3),^(10)
- . D CLEANTW^PRSATPTW(PPI,DFN,DAY)
- ;
- P3 S ZENT=$S($E(ENT,2)="H"&('$G(PTPF)):"RG ",$E(ENT,1,2)="00":"RG ",1:"")
- I TC=1 D OT S:$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)&(AC="M2E") ZENT=ZENT_"HW " S ZENT=ZENT_"NP CP " G P31
- I TC=3!(TC=4) D LV,OT S:$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)&($E(ENT,22)) ZENT=ZENT_"HW " G P31 ;PRS*137
- D LV,OT S ZENT=ZENT_"TV TR " S:$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) ZENT=ZENT_"HX HW "
- P31 S DDSFILE=458,DDSFILE(1)=458.02,DA(2)=PPI,DA(1)=DFN,DA=DAY
- S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,2)) K ZS
- S DR="[PRSA TP POST1]" D ^DDS K DS
- ; timekeeper has indicated there are exceptions, if they don't enter any, quit.
- I '$D(ZS) QUIT:'$D(^PRST(458,PPI,"E",DFN,"D",DAY,2)) S PTY=3 G UPD
- I ZS'="" S ^PRST(458,PPI,"E",DFN,"D",DAY,2)=ZS,PTY=3 G UPD
- ; if employee had exceptions, but timekeeper deletes them, then clear posting
- ; data because prompts that the employee was not absent and did not work
- ; entire tour were answered such that there must be exceptions
- I $D(^PRST(458,PPI,"E",DFN,"D",DAY,2)) D
- . K ^(2),^(3),^(10)
- . D CLEANTW^PRSATPTW(PPI,DFN,DAY)
- Q
- UPD ; Update status
- D TELEWORK^PRSATPTW(PPI,DFN,DAY,STAT,PTY,TC)
- D NOW^%DTC
- S $P(^PRST(458,PPI,"E",DFN,"D",DAY,10),"^",1,4)="T^"_DUZ_"^"_%_"^"_PTY
- N DAH,DBH,HOL,QUIT
- S (DAH,DBH,HOL,QUIT)=""
- ;
- ; Check to holiday encapsulated by a form a non-pay
- D HENCAP^PRSATP3(PPI,DFN,DAY,.DBH,.HOL,.DAH,.QUIT)
- Q:QUIT
- D UPDT^PRSATP3(DFN,DBH,HOL,DAH)
- K DAH,DBH,HOL,QUIT
- Q
- LP W !!,"Enter '^' to bypass this employee." W:LP=1 " Enter '^^' to stop T&L editing." W ! Q
- LV S Z1="30 31 31 31 32 33 28 35 35 30 36 37 38",Z2="AL SL CB AD NL WP CU AA DL RL NP CP HX"
- ;
- ; Check to see if the employee is entitled to Military Leave and add
- ; ML to list if they are. Added to be compliant with Public Law
- ; 106-554.
- S:$E(ENT,34) Z1=Z1_" 34",Z2=Z2_" ML"
- ;9/3 month employee entitled RS with recess hours in file# 458.8
- S:$E(ENT,5)&$P($$RSHR^PRSU1B2(DFN,PPE),U,DAY>7+1) Z1=Z1_" 5",Z2=Z2_" RS"
- F K=1:1:$L(Z1," ") I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" "
- QUIT
- ;
- OT ; Get entitled out-of-tour types of time
- S Z1="12 28 26",Z2="OT CT ON" F K=1:1:3 I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" " I ZENT'["UN" S ZENT=ZENT_"UN "
- I $E(ENT,29),'$E(ENT,26) S ZENT=ZENT_"SB " S:ZENT'["UN" ZENT=ZENT_"UN "
- ; Allow Stand By for employees w/ Prem Pay Ind = W or V
- I $E(ENT,29),$E(ENT,26),"^W^V^"[(U_PMP_U) S ZENT=ZENT_"SB " S:ZENT'["UN" ZENT=ZENT_"UN "
- Q
- EX ;clean up lock global which is set in $$AVAILREC^PRSLIB00
- K ^TMP($J,"LOCK")
- ;generic cleanup
- G KILL^XUSCLEAN
- ;
- PTPSCR(PRSIEN,PSTDT,PTPF) ; part-time physician screen extrinsic function
- ; input
- ; PRSIEN - Employee IEN (file 450)
- ; PSTDT - Date being posted (FileMan internal)
- ; PTPF - (opt) Part-time physician flag, equals true (1) when screen
- ; should only allow selection of part-time physician with
- ; memo and false (null or 0) when screen should only
- ; allow selection of employees that are not part-time
- ; physicians with memo.
- ; result
- ; returns a boolean value (1 or 0) or null
- ; =1 if employee passed screen
- ; (PTPF true and employee is PTP with memo) OR
- ; (PTPF false and employee is not PTP with memo)
- ; =0 if employee did not pass screen
- ; =null value if required inputs were not provided
- ;
- N PRSRET,PTPM
- S PTPF=$G(PTPF)
- S PRSRET="" ; init return
- I PRSIEN,PSTDT D
- . ; determine if employee is PT physician with memo on the posting date
- . S PTPM=$S($$MIEN^PRSPUT1(PRSIEN,PSTDT)>0:1,1:0)
- . ; apply screen
- . S PRSRET=$S(PTPF&PTPM:1,'PTPF&'PTPM:1,1:0)
- ;
- Q PRSRET
- ;
- ;PRSATP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSATP 7672 printed Jan 18, 2025@03:25:47 Page 2
- PRSATP ;HISC/REL,WIRMFO/MGD/PLT - Timekeeper Post Time ;4/13/2012
- +1 ;;4.0;PAID;**22,57,69,92,102,93,112,126,132,137**;Sep 21, 1995;Build 4
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ; input (from calling option)
- +4 ; PTPF - (optional) part-time physician flag, true (=1) when called
- +5 ; by the posting option for part-time physicians with a memo.
- +6 ;
- +7 ; global reference for employee's time & attendance record.
- NEW GLOB
- +8 NEW PRSDT
- +9 SET PRSTLV=2
- DO ^PRSAUTL
- if TLI<1
- GOTO EX
- SET %DT="X"
- SET X="T+3"
- DO ^%DT
- +10 SET %DT="AEPX"
- SET %DT("A")="Posting Date: "
- SET %DT("B")="T-1"
- SET %DT(0)=-Y
- WRITE !
- DO ^%DT
- +11 if Y<1
- GOTO EX
- SET (PRSDT,D1)=Y
- SET Y=$GET(^PRST(458,"AD",D1))
- SET PPI=$PIECE(Y,"^",1)
- SET DAY=$PIECE(Y,"^",2)
- +12 IF PPI=""
- WRITE !!,$CHAR(7),"Pay Period is Not Open Yet!"
- GOTO EX
- +13 SET PPE=$PIECE($GET(^PRST(458,PPI,0)),"^",1)
- SET DTE=$PIECE($GET(^PRST(458,PPI,2)),"^",DAY)
- SET DTI=$PIECE($GET(^(1)),"^",DAY)
- D2 WRITE !!,"Would you like to edit the T & A RECORDs in alphabetical order"
- SET %=1
- DO YN^DICN
- IF %
- SET LP=%
- if %=-1
- GOTO EX
- if %=1
- GOTO LOOP
- GOTO NME
- +1 WRITE !!,"Answer YES if you want all RECORDs brought up for which no data"
- +2 WRITE !,"has been entered."
- GOTO D2
- +3 ;
- +4 ;
- LOOP ;
- +1 SET LP=1
- SET NN=""
- +2 FOR
- SET NN=$ORDER(^PRSPC("ATL"_TLE,NN))
- if NN=""
- QUIT
- FOR DFN=0:0
- SET DFN=$ORDER(^PRSPC("ATL"_TLE,NN,DFN))
- if DFN<1
- QUIT
- IF $$PTPSCR(DFN,PRSDT,$GET(PTPF))
- SET GLOB=""
- DO POST
- if GLOB]""
- DO UNLOCK^PRSLIB00(GLOB)
- DO NURSEPOC^PRSNEETP(TLI,PPI,DFN,PRSDT)
- IF 'LP
- GOTO EX
- +3 GOTO EX
- NME KILL DIC
- SET DIC("A")="Select EMPLOYEE: "
- SET DIC("S")="I $P(^(0),""^"",8)=TLE,$D(^PRST(458,PPI,""E"",+Y)),$$PTPSCR^PRSATP(+Y,PRSDT,$G(PTPF))"
- SET DIC(0)="AEQM"
- SET DIC="^PRSPC("
- SET D="ATL"_TLE
- WRITE !
- DO IX^DIC
- SET DFN=+Y
- KILL DIC
- +1 if DFN<1
- GOTO EX
- SET GLOB=""
- DO POST
- if GLOB]""
- DO UNLOCK^PRSLIB00(GLOB)
- DO NURSEPOC^PRSNEETP(TLI,PPI,DFN,PRSDT)
- GOTO NME
- POST SET TC=$PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2)
- SET TC2=$PIECE($GET(^(0)),"^",13)
- +1 IF 'TC
- if LP'=2
- QUIT
- WRITE !!?5,"This Employee has no tour entered for this date."
- QUIT
- +2 IF "T"'[$PIECE($GET(^PRST(458,PPI,"E",DFN,0)),"^",2)
- if LP=2
- WRITE $CHAR(7),!!,"This Employee has already been sent to Payroll."
- QUIT
- +3 SET STAT=$PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",1)
- +4 IF LP=1
- IF "1 3 4"[TC!(STAT'="")
- QUIT
- +5 ;
- +6 ; check if ESR is approved when posting PT Phy with memo
- +7 IF $GET(PTPF)
- IF $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,7)),U)=5
- Begin DoDot:1
- +8 WRITE $CHAR(7),!
- +9 WRITE !,"This day was auto-posted from an approved Electronic Subsidiary Record (ESR)."
- +10 WRITE !,"Normally, changes should be accomplished by having the T & L supervisor return"
- +11 WRITE !,"the ESR day to the part-time physician for correction."
- +12 WRITE !,"An exception to the above is when AWOL, On Suspension, or Non-Pay must be"
- +13 WRITE !,"posted, since those can not be entered via the ESR.",!
- +14 SET DIR(0)="Y"
- +15 SET DIR("A")="Do you want to manually post this day on the timecard"
- +16 SET DIR("B")="NO"
- +17 DO ^DIR
- KILL DIR
- End DoDot:1
- if 'Y!$DATA(DIRUT)
- QUIT
- +18 ;
- +19 ; lock employee record for editing by timekeeper
- +20 IF '$$AVAILREC^PRSLIB00("TK",.GLOB,.STOP)
- if LP=1&$GET(STOP)
- SET LP=0
- QUIT
- +21 DO ^PRSADP1
- DO LP
- DO ^PRSATP2
- DO ^PRSAENT
- +22 if TC>4
- GOTO P0
- if TC=2
- GOTO P0
- if TC=3
- GOTO P0
- if TC=4
- GOTO P3
- GOTO P1
- P0 READ !!,"Did Employee Only Work Scheduled Tour? ",X:DTIME
- if '$TEST
- SET X="^^"
- if X["^^"
- SET LP=0
- if X["^"
- QUIT
- SET X=$TRANSLATE(X,"yesnor","YESNOR")
- +1 if X=""
- SET X="*"
- IF $PIECE("YES",X,1)'=""
- IF $PIECE("NO",X,1)'=""
- IF X'="R"
- WRITE $CHAR(7),!?5," Answer YES or NO or R for Normal Posting with Remarks"
- GOTO P0
- +2 SET X=$EXTRACT(X,1)
- IF "YR"'[X
- GOTO P1
- +3 SET PTY=1
- IF STAT'=""
- KILL ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3)
- +4 IF TC=3
- SET $PIECE(^PRST(458,PPI,"E",DFN,"D",DAY,2),"^",3)="RG"
- SET STAT="T"
- +5 IF STAT'=""
- IF $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)
- DO NOW^%DTC
- SET NOW=%
- SET TT="HW"
- DO S0^PRSAPPH
- +6 SET LV=""
- if X="R"
- DO A2^PRSATP0
- GOTO UPD
- P1 READ !!,"Was Employee Absent the Entire Tour? ",X:DTIME
- if '$TEST
- SET X="^"
- if X["^"
- QUIT
- SET X=$TRANSLATE(X,"yesno","YESNO")
- +1 if X=""
- SET X="*"
- IF $PIECE("YES",X,1)'=""
- IF $PIECE("NO",X,1)'=""
- WRITE $CHAR(7)," Answer YES or NO"
- GOTO P1
- +2 IF X?1"Y".E
- DO ^PRSATP0
- if X["^"
- QUIT
- GOTO UPD
- +3 ;
- +4 ;for daily employees if you say they didn't work and they were not absent
- +5 ;then effectively you have not created any posting for the day and we
- +6 ;clean up any prior posting
- +7 IF $EXTRACT(ENT,1,2)["D"
- Begin DoDot:1
- +8 KILL ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3),^(10)
- +9 DO CLEANTW^PRSATPTW(PPI,DFN,DAY)
- End DoDot:1
- QUIT
- +10 ;
- P3 SET ZENT=$SELECT($EXTRACT(ENT,2)="H"&('$GET(PTPF)):"RG ",$EXTRACT(ENT,1,2)="00":"RG ",1:"")
- +1 IF TC=1
- DO OT
- if $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)&(AC="M2E")
- SET ZENT=ZENT_"HW "
- SET ZENT=ZENT_"NP CP "
- GOTO P31
- +2 ;PRS*137
- IF TC=3!(TC=4)
- DO LV
- DO OT
- if $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)&($EXTRACT(ENT,22))
- SET ZENT=ZENT_"HW "
- GOTO P31
- +3 DO LV
- DO OT
- SET ZENT=ZENT_"TV TR "
- if $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)
- SET ZENT=ZENT_"HX HW "
- P31 SET DDSFILE=458
- SET DDSFILE(1)=458.02
- SET DA(2)=PPI
- SET DA(1)=DFN
- SET DA=DAY
- +1 SET Z=$GET(^PRST(458,PPI,"E",DFN,"D",DAY,2))
- KILL ZS
- +2 SET DR="[PRSA TP POST1]"
- DO ^DDS
- KILL DS
- +3 ; timekeeper has indicated there are exceptions, if they don't enter any, quit.
- +4 IF '$DATA(ZS)
- if '$DATA(^PRST(458,PPI,"E",DFN,"D",DAY,2))
- QUIT
- SET PTY=3
- GOTO UPD
- +5 IF ZS'=""
- SET ^PRST(458,PPI,"E",DFN,"D",DAY,2)=ZS
- SET PTY=3
- GOTO UPD
- +6 ; if employee had exceptions, but timekeeper deletes them, then clear posting
- +7 ; data because prompts that the employee was not absent and did not work
- +8 ; entire tour were answered such that there must be exceptions
- +9 IF $DATA(^PRST(458,PPI,"E",DFN,"D",DAY,2))
- Begin DoDot:1
- +10 KILL ^(2),^(3),^(10)
- +11 DO CLEANTW^PRSATPTW(PPI,DFN,DAY)
- End DoDot:1
- +12 QUIT
- UPD ; Update status
- +1 DO TELEWORK^PRSATPTW(PPI,DFN,DAY,STAT,PTY,TC)
- +2 DO NOW^%DTC
- +3 SET $PIECE(^PRST(458,PPI,"E",DFN,"D",DAY,10),"^",1,4)="T^"_DUZ_"^"_%_"^"_PTY
- +4 NEW DAH,DBH,HOL,QUIT
- +5 SET (DAH,DBH,HOL,QUIT)=""
- +6 ;
- +7 ; Check to holiday encapsulated by a form a non-pay
- +8 DO HENCAP^PRSATP3(PPI,DFN,DAY,.DBH,.HOL,.DAH,.QUIT)
- +9 if QUIT
- QUIT
- +10 DO UPDT^PRSATP3(DFN,DBH,HOL,DAH)
- +11 KILL DAH,DBH,HOL,QUIT
- +12 QUIT
- LP WRITE !!,"Enter '^' to bypass this employee."
- if LP=1
- WRITE " Enter '^^' to stop T&L editing."
- WRITE !
- QUIT
- LV SET Z1="30 31 31 31 32 33 28 35 35 30 36 37 38"
- SET Z2="AL SL CB AD NL WP CU AA DL RL NP CP HX"
- +1 ;
- +2 ; Check to see if the employee is entitled to Military Leave and add
- +3 ; ML to list if they are. Added to be compliant with Public Law
- +4 ; 106-554.
- +5 if $EXTRACT(ENT,34)
- SET Z1=Z1_" 34"
- SET Z2=Z2_" ML"
- +6 ;9/3 month employee entitled RS with recess hours in file# 458.8
- +7 if $EXTRACT(ENT,5)&$PIECE($$RSHR^PRSU1B2(DFN,PPE),U,DAY>7+1)
- SET Z1=Z1_" 5"
- SET Z2=Z2_" RS"
- +8 FOR K=1:1:$LENGTH(Z1," ")
- IF $EXTRACT(ENT,$PIECE(Z1," ",K))
- SET ZENT=ZENT_$PIECE(Z2," ",K)_" "
- +9 QUIT
- +10 ;
- OT ; Get entitled out-of-tour types of time
- +1 SET Z1="12 28 26"
- SET Z2="OT CT ON"
- FOR K=1:1:3
- IF $EXTRACT(ENT,$PIECE(Z1," ",K))
- SET ZENT=ZENT_$PIECE(Z2," ",K)_" "
- IF ZENT'["UN"
- SET ZENT=ZENT_"UN "
- +2 IF $EXTRACT(ENT,29)
- IF '$EXTRACT(ENT,26)
- SET ZENT=ZENT_"SB "
- if ZENT'["UN"
- SET ZENT=ZENT_"UN "
- +3 ; Allow Stand By for employees w/ Prem Pay Ind = W or V
- +4 IF $EXTRACT(ENT,29)
- IF $EXTRACT(ENT,26)
- IF "^W^V^"[(U_PMP_U)
- SET ZENT=ZENT_"SB "
- if ZENT'["UN"
- SET ZENT=ZENT_"UN "
- +5 QUIT
- EX ;clean up lock global which is set in $$AVAILREC^PRSLIB00
- +1 KILL ^TMP($JOB,"LOCK")
- +2 ;generic cleanup
- +3 GOTO KILL^XUSCLEAN
- +4 ;
- PTPSCR(PRSIEN,PSTDT,PTPF) ; part-time physician screen extrinsic function
- +1 ; input
- +2 ; PRSIEN - Employee IEN (file 450)
- +3 ; PSTDT - Date being posted (FileMan internal)
- +4 ; PTPF - (opt) Part-time physician flag, equals true (1) when screen
- +5 ; should only allow selection of part-time physician with
- +6 ; memo and false (null or 0) when screen should only
- +7 ; allow selection of employees that are not part-time
- +8 ; physicians with memo.
- +9 ; result
- +10 ; returns a boolean value (1 or 0) or null
- +11 ; =1 if employee passed screen
- +12 ; (PTPF true and employee is PTP with memo) OR
- +13 ; (PTPF false and employee is not PTP with memo)
- +14 ; =0 if employee did not pass screen
- +15 ; =null value if required inputs were not provided
- +16 ;
- +17 NEW PRSRET,PTPM
- +18 SET PTPF=$GET(PTPF)
- +19 ; init return
- SET PRSRET=""
- +20 IF PRSIEN
- IF PSTDT
- Begin DoDot:1
- +21 ; determine if employee is PT physician with memo on the posting date
- +22 SET PTPM=$SELECT($$MIEN^PRSPUT1(PRSIEN,PSTDT)>0:1,1:0)
- +23 ; apply screen
- +24 SET PRSRET=$SELECT(PTPF&PTPM:1,'PTPF&'PTPM:1,1:0)
- End DoDot:1
- +25 ;
- +26 QUIT PRSRET
- +27 ;
- +28 ;PRSATP