Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRSASR.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSASR.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSASR.m
r613 r623 1 PRSASR ;HISC/MGD,WOIFO/JAH/PLT - Supervisor Certification ;02/05/2005 2 ;;4.0;PAID;**2,7,8,22,37,43,82,93,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;Called by Pay Per Cert Option on T&A Superv menu. Timecard 4 each 6 ;employee in this supervs T&L is displayed. Superv prompted at each 7 ;display as to whether card is ready 4 certification. Cards that r 8 ;ready r saved in ^TMP. After this review--elect sign code is 9 ;required to release approved cards to payroll. Upon ES 10 ; 8b, exceptions, & ot warnings r stored & timecard status 11 ;changed to 'P'--'released to payroll' 12 ; 13 ;===================================================================== 14 ; 15 ;Set up reverse video ON & OFF for tour error highlighting 16 N IORVOFF,IORVON,IOINHI,IOINORM,IOBOFF,IOBON,RESP 17 S X="IORVOFF;IORVON;IOBOFF;IOBON;IOINHI;IOINORM" D ENDR^%ZISS 18 ; 19 N MIDPP,DUMMY 20 S MIDPP="In middle of Pay Period; Cannot Certify & Release." 21 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM" 22 W !?27,"SUPERVISORY CERTIFICATION" 23 S PRSTLV=3 D ^PRSAUTL G:TLI<1 EX 24 D NOW^%DTC 25 S DT=%\1,APDT=%,Y=$G(^PRST(458,"AD",DT)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2) 26 I DAY>5,DAY<11 W $C(7),!!,MIDPP G EX 27 I DAY<6 S X1=DT,X2=-7 D C^%DTC S PPI=$P($G(^PRST(458,"AD",X)),"^",1) G:'PPI EX 28 ; ----------------------------------------- 29 P0 ;PDT = string of pay period dates with format - Sun 29-Sep-96^ 30 ;PDTI = string of pay period dates in fileman format. 31 ;PPI = pay period internal entry number in file 458. 32 ;GLOB = global reference for employees pay period record 33 ; returned from $$AVAILREC & passed to UNLOCK. 34 ; ----------------------------------------- 35 ; 36 S PDT=$G(^PRST(458,PPI,2)),PDTI=$G(^(1)),QT=0 K ^TMP($J) 37 ; 38 ; ----------------------------------------- 39 ;Loop thru this supervisor's T&L unit on x-ref in 450. 40 ;$$availrec() ensures there's data & node with employee's 41 ;pay period record is NOT locked, then locks node. 42 ;Call to CHK checks for needed approvals for current employee 43 ;If supervisor decides record is not ready, during this call, 44 ;then node is unlocked. Records that super accepts for release 45 ;are not unlocked until they are processed thru temp global 46 ;& their status' are updated. 47 ; --------------------------------------------------- 48 ; 49 S NN="",CKS=1 50 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 $$AVAILREC^PRSLIB00("SUP",.GLOB) D CHK I QT G T0 51 ; 52 ; --------------------------------------------------- 53 ;Loop through T&L unit file x-ref 2 c if this supervisor certifies 54 ;payperiod data for other supervisors of other T&L units. If so 55 ;process after ensuring node to be certified is available. 56 ; --------------------------------------------------- 57 ; 58 S CKS=0 59 F VA2=0:0 S VA2=$$TLSUP Q:VA2<1 S SSN=$$SSN I SSN'="" S DFN=$$DFN S Z=$P($G(^PRSPC(+DFN,0)),"^",8) I Z'="",Z'=TLE,$$AVAILREC^PRSLIB00("SUP",.GLOB) D CHK I QT G EX:'$T,T0 60 ; 61 ; --------------------------------------------------- 62 T0 I $D(^TMP($J,"E")) G T1 63 W !!,"No records have been selected for certification." 64 S DUMMY=$$ASK^PRSLIB00(1) G EX 65 ; 66 ; --------------------------------------------------- 67 ; 68 T1 ;if supervisor signs off then update all records in tmp 69 ;otherwise remove any auto posting. 70 D ^PRSAES I ESOK D 71 .D NOW^%DTC S APDT=% 72 .F DFN=0:0 S DFN=$O(^TMP($J,"E",DFN)) Q:DFN<1 S VAL=$G(^(DFN)) D PROC 73 I 'ESOK D 74 .F DFN=0:0 S DFN=$O(^TMP($J,"E",DFN)) Q:DFN<1 D 75 ..D AUTOPINI^PRS8(PPI,DFN) 76 D EX 77 Q 78 ; 79 ; --------------------------------------------------- 80 CHK ; Check for needed approvals 81 N PRSENT,PRSWOC 82 S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) I "PX"[STAT Q 83 I USR=DFN Q:'$D(^XUSEC("PRSA SIGN",DUZ)) 84 E I CKS S SSN=$P($G(^PRSPC(DFN,0)),"^",9) I SSN S EDUZ=+$O(^VA(200,"SSN",SSN,0)) I $D(^PRST(455.5,"AS",EDUZ,TLI)) Q:$P($G(^PRST(455.5,TLI,"S",EDUZ,0)),"^",2)'=TLE 85 S HDR=0 D HDR,^PRSAENT S PRSENT=ENT 86 ; 87 ;Loop to display tour, exceptions(leave, etc..) & errors. 88 ; 89 S (XF,X9)=0 90 F DAY=1:1:14 D TOURERR($P(PDT,"^",DAY),.X9,.XF) D:$Y>(IOSL-6)&(DAY<14) HDR G:QT O1 91 ; 92 ;Display VCS commission sales, if applicable 93 S Z=$G(^PRST(458,PPI,"E",DFN,2)) 94 I Z'="" D:$Y>(IOSL-11) HDR Q:QT D VCS^PRSASR1 95 ; 96 ; 97 S Z=$G(^PRST(458,PPI,"E",DFN,4)) 98 I Z'="" D:$Y>(IOSL-9) HDR Q:QT D ED^PRSASR1 99 I XF W !,IORVON,"Serious error; cannot release.",IORVOFF S QT=$$ASK^PRSLIB00() Q 100 S QT=$$ASK^PRSLIB00() Q:QT 101 ; 102 ;PRS8 call creates & stores 8B string in employees attendance 103 ;record. Later, under a payroll option, string will be 104 ;transmitted to Austin. 105 ; 106 N NN D ONE^PRS8 S C0=$G(^PRSPC(DFN,0)),PY=PPI D CERT^PRS8VW S QT=0 107 ; 108 ;Show OT (approve-vs-8B) warning & save in TMP. 109 N WK,OTERR,O8,OA 110 F WK=1:1:2 D 111 . D WARNSUP^PRSAOTT(PPE,DFN,VAL,WK,.OTERR,.O8,.OA) 112 . I OTERR S ^TMP($J,"OT",DFN,WK)=O8_"^"_OA 113 ; 114 ;warning message for rs/rn and on type of time 115 I $E(PRSENT,5) D 116 . I @($TR($$CD8B^PRSU1B2(VAL,"RS^3^RN^3",1),U,"+")_"-("_$TR($$RSHR^PRSU1B2(DFN,PPI),U,"+")_")") W !,?3,"WARNING: The total scheduled recess hours for this pay period does not match the total RS/RN posted." 117 . I $G(PRSWOC)]"" W !,?3,"Warning: The entire tour for day# ",PRSWOC," is posted RECESS. The On-Call will be paid unless posted UNAVAILABLE." 118 . QUIT 119 ; 120 LD ; Check for changes to the Labor Distribution Codes made during the pay 121 ; period. 122 I $D(^PRST(458,PPI,"E",DFN,"LDAUD")) D LD^PRSASR1 123 ; --------------------------------------------------- 124 OK ;Prompt Supervisor to release timecard. If yes, store in ^TMP(. 125 ;If supervisor answers no then bypass & unlock record. 126 ; --------------------------------------------------- 127 W !!,IORVON,"Release to Payroll?",IORVOFF," " 128 R X:DTIME S:'$T!(X["^") QT=1 Q:QT S:X="" X="*" S X=$TR(X,"yesno","YESNO") 129 I $P("YES",X,1)'="",$P("NO",X,1)'="" W $C(7)," Answer YES or NO" G OK 130 I X?1"Y".E S ^TMP($J,"E",DFN)=VAL 131 E D 132 . D AUTOPINI^PRS8(PPI,DFN) ; remove any auto posting 133 . D UNLOCK^PRSLIB00(GLOB) ; unlock record 134 . K ^TMP($J,"LOCK",DFN) ;clean out of local lock list. 135 O1 Q 136 ; 137 PROC ; Set Approval, file any exceptions & update 8B string 138 ; 139 ; get employees entitlement string in variable A1 140 D ^PRSAENT 141 ; 142 ; set approvals 143 S $P(^PRST(458,PPI,"E",DFN,0),"^",3,5)=DUZ_"^"_APDT_"^"_A1 144 ; VCS approval 145 I $D(^PRST(458,PPI,"E",DFN,2)) S $P(^(2),"^",17,18)=DUZ_"^"_APDT 146 ; 147 ; loop thru any exceptions & file in 458.5 148 I $D(^TMP($J,"X",DFN)) S K="" F S K=$O(^TMP($J,"X",DFN,K)) Q:K="" S DAY=$P(K," ",1),X1=$P(PDTI,"^",DAY),X2=$G(^(K)) D ^PRSATPF 149 ; 150 ; file overtime warnings 151 F WK=1:1:2 I $G(^TMP($J,"OT",DFN,WK))'="" D 152 . S O8=$P(^TMP($J,"OT",DFN,WK),"^") 153 . S OA=$P(^TMP($J,"OT",DFN,WK),"^",2) 154 . D FILEOTW^PRSAOTTF(PPI,DFN,WK,O8,OA) 155 ; 156 ;set 8b string & change status of timecard to payroll 157 S ^PRST(458,PPI,"E",DFN,5)=VAL S $P(^PRST(458,PPI,"E",DFN,0),"^",2)="P" 158 ; 159 ; If employee is a PT Phys w/ memo update hours credited 160 D PTP^PRSASR1(DFN,PPI) 161 ; 162 ;unlock employees time card record 163 S GLOB="^PRST(458,"_PPI_","_"""E"""_","_DFN_",0)" 164 D UNLOCK^PRSLIB00(GLOB) 165 K ^TMP($J,"LOCK",DFN) ;clean out of local lock list. 166 Q 167 ; 168 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 169 ; 170 HDR ; Display Header 171 I HDR S QT=$$ASK^PRSLIB00() Q:QT 172 S X=$G(^PRSPC(DFN,0)) W !,@IOF,?3,$P(X,"^",1) S X=$P(X,"^",9) I X W ?68,$E(X),"XX-XX-",$E(X,6,9) S HDR=1 173 W !,?6,"Date",?20,"Scheduled Tour",?40,"Tour Exceptions",?63,IORVON,"Tour Errors",IORVOFF 174 W !?3 F I=1:1:72 W "-" 175 Q 176 ;==================================================================== 177 HDR2 ; Display Header don't quit 178 N HOLD 179 S HOLD=$$ASK^PRSLIB00(1) 180 S X=$G(^PRSPC(DFN,0)) W !,@IOF,?3,$P(X,"^",1) S X=$P(X,"^",9) I X W ?68,$E(X),"XX-XX-",$E(X,6,9) 181 W !,?6,"Date",?20,"Scheduled Tour",?40,"Tour Exceptions",?63,IORVON,"Tour Errors",IORVOFF 182 W !?3 F I=1:1:72 W "-" 183 Q 184 ;==================================================================== 185 ; 186 EX ; clean up variables & unlock any leftover time card nodes 187 N EMPREC 188 S EMPREC="" 189 F S EMPREC=$O(^TMP($J,"LOCK",EMPREC)) Q:EMPREC="" D 190 . S GLOB="^PRST(458,"_PPI_","_"""E"""_","_EMPREC_",0)" 191 . D UNLOCK^PRSLIB00(GLOB) 192 K ^TMP($J) G KILL^XUSCLEAN 193 Q 194 ; 195 ; 196 ;These extrinsic functions simply remove lengthy code from long, 197 ;single line, nested loop. 198 ; --------------------------------------------------- 199 TLSUP() ;get next supervisor who certifies other supervisors 200 Q $O(^PRST(455.5,"ASX",TLE,VA2)) 201 ; --------------------------------------------------- 202 SSN() ;get ssn of supervisor to be certified by this supervisor. 203 Q $P($G(^VA(200,VA2,1)),"^",9) 204 ; --------------------------------------------------- 205 DFN() ;get internal entry number of supvisor of other T&L 2b approved 206 ;by current supervisor. 207 Q $O(^PRSPC("SSN",SSN,0)) 208 ;==================================================================== 209 TOURERR(DTE,X9,XF) ;DISPLAY TOUR & ERRORS 210 ; 211 N IORVOFF,IORVON,RESP,ERRLEN 212 S X="IORVOFF;IORVON" D ENDR^%ZISS 213 D F1^PRSADP1,^PRSATPE 214 F K=1:1 Q:'$D(Y1(K))&'$D(Y2(K)) D 215 . I $Y>(IOSL-4) D HDR2 216 . W:K>1 ! 217 . W:$D(Y1(K)) ?21,Y1(K) 218 . W:$P($G(Y2(K)),"^")'="" ?45,$P(Y2(K),"^",1) 219 . I $P($G(Y2(K)),"^",2)'="" W:$X>44 ! W ?45,$P(Y2(K),"^",2) 220 W:Y3'="" !?10,Y3 221 I $D(ER) S:FATAL XF=1 F K=0:0 S K=$O(ER(K)) Q:K<1 D 222 . I $Y>(IOSL-4) D HDR2 223 .W:X9!($X>55) ! S ERRLEN=23 224 .I $P(ER(K),"^",2)'="" S ERRLEN=$L(ER(K)) 225 .W ?(IOM-(ERRLEN+1)),IORVON 226 .W:$P(ER(K),"^",2)'="" $P(ER(K),"^",2) 227 .W " ",$P(ER(K),"^",1),IORVOFF 228 .S X9=0 S:'XF ^TMP($J,"X",DFN,DAY_" "_K)=ER(K) 229 .Q 230 Q 1 PRSASR ;HISC/MGD,WOIFO/JAH - Supervisor Certification ;02/05/2005 2 ;;4.0;PAID;**2,7,8,22,37,43,82,93**;Sep 21, 1995;Build 7 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;Called by Pay Per Cert Option on T&A Superv menu. Timecard 4 each 6 ;employee in this supervs T&L is displayed. Superv prompted at each 7 ;display as to whether card is ready 4 certification. Cards that r 8 ;ready r saved in ^TMP. After this review--elect sign code is 9 ;required to release approved cards to payroll. Upon ES 10 ; 8b, exceptions, & ot warnings r stored & timecard status 11 ;changed to 'P'--'released to payroll' 12 ; 13 ;===================================================================== 14 ; 15 ;Set up reverse video ON & OFF for tour error highlighting 16 N IORVOFF,IORVON,IOINHI,IOINORM,IOBOFF,IOBON,RESP 17 S X="IORVOFF;IORVON;IOBOFF;IOBON;IOINHI;IOINORM" D ENDR^%ZISS 18 ; 19 N MIDPP,DUMMY 20 S MIDPP="In middle of Pay Period; Cannot Certify & Release." 21 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM" 22 W !?27,"SUPERVISORY CERTIFICATION" 23 S PRSTLV=3 D ^PRSAUTL G:TLI<1 EX 24 D NOW^%DTC 25 S DT=%\1,APDT=%,Y=$G(^PRST(458,"AD",DT)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2) 26 I DAY>5,DAY<11 W $C(7),!!,MIDPP G EX 27 I DAY<6 S X1=DT,X2=-7 D C^%DTC S PPI=$P($G(^PRST(458,"AD",X)),"^",1) G:'PPI EX 28 ; ----------------------------------------- 29 P0 ;PDT = string of pay period dates with format - Sun 29-Sep-96^ 30 ;PDTI = string of pay period dates in fileman format. 31 ;PPI = pay period internal entry number in file 458. 32 ;GLOB = global reference for employees pay period record 33 ; returned from $$AVAILREC & passed to UNLOCK. 34 ; ----------------------------------------- 35 ; 36 S PDT=$G(^PRST(458,PPI,2)),PDTI=$G(^(1)),QT=0 K ^TMP($J) 37 ; 38 ; ----------------------------------------- 39 ;Loop thru this supervisor's T&L unit on x-ref in 450. 40 ;$$availrec() ensures there's data & node with employee's 41 ;pay period record is NOT locked, then locks node. 42 ;Call to CHK checks for needed approvals for current employee 43 ;If supervisor decides record is not ready, during this call, 44 ;then node is unlocked. Records that super accepts for release 45 ;are not unlocked until they are processed thru temp global 46 ;& their status' are updated. 47 ; --------------------------------------------------- 48 ; 49 S NN="",CKS=1 50 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 $$AVAILREC^PRSLIB00("SUP",.GLOB) D CHK I QT G T0 51 ; 52 ; --------------------------------------------------- 53 ;Loop through T&L unit file x-ref 2 c if this supervisor certifies 54 ;payperiod data for other supervisors of other T&L units. If so 55 ;process after ensuring node to be certified is available. 56 ; --------------------------------------------------- 57 ; 58 S CKS=0 59 F VA2=0:0 S VA2=$$TLSUP Q:VA2<1 S SSN=$$SSN I SSN'="" S DFN=$$DFN S Z=$P($G(^PRSPC(+DFN,0)),"^",8) I Z'="",Z'=TLE,$$AVAILREC^PRSLIB00("SUP",.GLOB) D CHK I QT G EX:'$T,T0 60 ; 61 ; --------------------------------------------------- 62 T0 I $D(^TMP($J,"E")) G T1 63 W !!,"No records have been selected for certification." 64 S DUMMY=$$ASK^PRSLIB00(1) G EX 65 ; 66 ; --------------------------------------------------- 67 ; 68 T1 ;if supervisor signs off then update all records in tmp 69 ;otherwise remove any auto posting. 70 D ^PRSAES I ESOK D 71 .D NOW^%DTC S APDT=% 72 .F DFN=0:0 S DFN=$O(^TMP($J,"E",DFN)) Q:DFN<1 S VAL=$G(^(DFN)) D PROC 73 I 'ESOK D 74 .F DFN=0:0 S DFN=$O(^TMP($J,"E",DFN)) Q:DFN<1 D 75 ..D AUTOPINI^PRS8(PPI,DFN) 76 D EX 77 Q 78 ; 79 ; --------------------------------------------------- 80 CHK ; Check for needed approvals 81 S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) I "PX"[STAT Q 82 I USR=DFN Q:'$D(^XUSEC("PRSA SIGN",DUZ)) 83 E I CKS S SSN=$P($G(^PRSPC(DFN,0)),"^",9) I SSN S EDUZ=+$O(^VA(200,"SSN",SSN,0)) I $D(^PRST(455.5,"AS",EDUZ,TLI)) Q:$P($G(^PRST(455.5,TLI,"S",EDUZ,0)),"^",2)'=TLE 84 S HDR=0 D HDR 85 ; 86 ;Loop to display tour, exceptions(leave, etc..) & errors. 87 ; 88 S (XF,X9)=0 89 F DAY=1:1:14 D TOURERR($P(PDT,"^",DAY),.X9,.XF) D:$Y>(IOSL-6)&(DAY<14) HDR G:QT O1 90 ; 91 ;Display VCS commission sales, if applicable 92 S Z=$G(^PRST(458,PPI,"E",DFN,2)) 93 I Z'="" D:$Y>(IOSL-11) HDR Q:QT D VCS^PRSASR1 94 ; 95 ; 96 S Z=$G(^PRST(458,PPI,"E",DFN,4)) 97 I Z'="" D:$Y>(IOSL-9) HDR Q:QT D ED^PRSASR1 98 I XF W !,IORVON,"Serious error; cannot release.",IORVOFF S QT=$$ASK^PRSLIB00() Q 99 S QT=$$ASK^PRSLIB00() Q:QT 100 ; 101 ;PRS8 call creates & stores 8B string in employees attendance 102 ;record. Later, under a payroll option, string will be 103 ;transmitted to Austin. 104 ; 105 N NN D ONE^PRS8 S C0=$G(^PRSPC(DFN,0)),PY=PPI D CERT^PRS8VW S QT=0 106 ; 107 ;Show OT (approve-vs-8B) warning & save in TMP. 108 N WK,OTERR,O8,OA 109 F WK=1:1:2 D 110 . D WARNSUP^PRSAOTT(PPE,DFN,VAL,WK,.OTERR,.O8,.OA) 111 . I OTERR S ^TMP($J,"OT",DFN,WK)=O8_"^"_OA 112 ; 113 LD ; Check for changes to the Labor Distribution Codes made during the pay 114 ; period. 115 I $D(^PRST(458,PPI,"E",DFN,"LDAUD")) D LD^PRSASR1 116 ; --------------------------------------------------- 117 OK ;Prompt Supervisor to release timecard. If yes, store in ^TMP(. 118 ;If supervisor answers no then bypass & unlock record. 119 ; --------------------------------------------------- 120 W !!,IORVON,"Release to Payroll?",IORVOFF," " 121 R X:DTIME S:'$T!(X["^") QT=1 Q:QT S:X="" X="*" S X=$TR(X,"yesno","YESNO") 122 I $P("YES",X,1)'="",$P("NO",X,1)'="" W $C(7)," Answer YES or NO" G OK 123 I X?1"Y".E S ^TMP($J,"E",DFN)=VAL 124 E D 125 . D AUTOPINI^PRS8(PPI,DFN) ; remove any auto posting 126 . D UNLOCK^PRSLIB00(GLOB) ; unlock record 127 . K ^TMP($J,"LOCK",DFN) ;clean out of local lock list. 128 O1 Q 129 ; 130 PROC ; Set Approval, file any exceptions & update 8B string 131 ; 132 ; get employees entitlement string in variable A1 133 D ^PRSAENT 134 ; 135 ; set approvals 136 S $P(^PRST(458,PPI,"E",DFN,0),"^",3,5)=DUZ_"^"_APDT_"^"_A1 137 ; VCS approval 138 I $D(^PRST(458,PPI,"E",DFN,2)) S $P(^(2),"^",17,18)=DUZ_"^"_APDT 139 ; 140 ; loop thru any exceptions & file in 458.5 141 I $D(^TMP($J,"X",DFN)) S K="" F S K=$O(^TMP($J,"X",DFN,K)) Q:K="" S DAY=$P(K," ",1),X1=$P(PDTI,"^",DAY),X2=$G(^(K)) D ^PRSATPF 142 ; 143 ; file overtime warnings 144 F WK=1:1:2 I $G(^TMP($J,"OT",DFN,WK))'="" D 145 . S O8=$P(^TMP($J,"OT",DFN,WK),"^") 146 . S OA=$P(^TMP($J,"OT",DFN,WK),"^",2) 147 . D FILEOTW^PRSAOTTF(PPI,DFN,WK,O8,OA) 148 ; 149 ;set 8b string & change status of timecard to payroll 150 S ^PRST(458,PPI,"E",DFN,5)=VAL S $P(^PRST(458,PPI,"E",DFN,0),"^",2)="P" 151 ; 152 ; If employee is a PT Phys w/ memo update hours credited 153 D PTP^PRSASR1(DFN,PPI) 154 ; 155 ;unlock employees time card record 156 S GLOB="^PRST(458,"_PPI_","_"""E"""_","_DFN_",0)" 157 D UNLOCK^PRSLIB00(GLOB) 158 K ^TMP($J,"LOCK",DFN) ;clean out of local lock list. 159 Q 160 ; 161 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 162 ; 163 HDR ; Display Header 164 I HDR S QT=$$ASK^PRSLIB00() Q:QT 165 S X=$G(^PRSPC(DFN,0)) W !,@IOF,?3,$P(X,"^",1) S X=$P(X,"^",9) I X W ?68,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9) S HDR=1 166 W !,?6,"Date",?20,"Scheduled Tour",?40,"Tour Exceptions",?63,IORVON,"Tour Errors",IORVOFF 167 W !?3 F I=1:1:72 W "-" 168 Q 169 ;==================================================================== 170 HDR2 ; Display Header don't quit 171 N HOLD 172 S HOLD=$$ASK^PRSLIB00(1) 173 S X=$G(^PRSPC(DFN,0)) W !,@IOF,?3,$P(X,"^",1) S X=$P(X,"^",9) I X W ?68,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9) 174 W !,?6,"Date",?20,"Scheduled Tour",?40,"Tour Exceptions",?63,IORVON,"Tour Errors",IORVOFF 175 W !?3 F I=1:1:72 W "-" 176 Q 177 ;==================================================================== 178 ; 179 EX ; clean up variables & unlock any leftover time card nodes 180 N EMPREC 181 S EMPREC="" 182 F S EMPREC=$O(^TMP($J,"LOCK",EMPREC)) Q:EMPREC="" D 183 . S GLOB="^PRST(458,"_PPI_","_"""E"""_","_EMPREC_",0)" 184 . D UNLOCK^PRSLIB00(GLOB) 185 K ^TMP($J) G KILL^XUSCLEAN 186 Q 187 ; 188 ;==================================================================== 189 ;These extrinsic functions simply remove lengthy code from long, 190 ;single line, nested loop. 191 ; --------------------------------------------------- 192 TLSUP() ;get next supervisor who certifies other supervisors 193 Q $O(^PRST(455.5,"ASX",TLE,VA2)) 194 ; --------------------------------------------------- 195 SSN() ;get ssn of supervisor to be certified by this supervisor. 196 Q $P($G(^VA(200,VA2,1)),"^",9) 197 ; --------------------------------------------------- 198 DFN() ;get internal entry number of supvisor of other T&L 2b approved 199 ;by current supervisor. 200 Q $O(^PRSPC("SSN",SSN,0)) 201 ;==================================================================== 202 TOURERR(DTE,X9,XF) ;DISPLAY TOUR & ERRORS 203 ; 204 N IORVOFF,IORVON,RESP,ERRLEN 205 S X="IORVOFF;IORVON" D ENDR^%ZISS 206 D F1^PRSADP1,^PRSATPE 207 F K=1:1 Q:'$D(Y1(K))&'$D(Y2(K)) D 208 . I $Y>(IOSL-4) D HDR2 209 . W:K>1 ! 210 . W:$D(Y1(K)) ?21,Y1(K) 211 . W:$P($G(Y2(K)),"^")'="" ?45,$P(Y2(K),"^",1) 212 . I $P($G(Y2(K)),"^",2)'="" W:$X>44 ! W ?45,$P(Y2(K),"^",2) 213 W:Y3'="" !?10,Y3 214 I $D(ER) S:FATAL XF=1 F K=0:0 S K=$O(ER(K)) Q:K<1 D 215 . I $Y>(IOSL-4) D HDR2 216 .W:X9!($X>55) ! S ERRLEN=23 217 .I $P(ER(K),"^",2)'="" S ERRLEN=$L(ER(K)) 218 .W ?(IOM-(ERRLEN+1)),IORVON 219 .W:$P(ER(K),"^",2)'="" $P(ER(K),"^",2) 220 .W " ",$P(ER(K),"^",1),IORVOFF 221 .S X9=0 S:'XF ^TMP($J,"X",DFN,DAY_" "_K)=ER(K) 222 .Q 223 Q
Note:
See TracChangeset
for help on using the changeset viewer.
