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 Dec 13, 2024@02:24:37 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
