PRSXP89 ;WCIOFO/MGD-Report for Central PAID for PL 108-170 ;03/22/2004
;;4.0;PAID;**89**;Sep 21, 1995
;;This routine is not a part of the VistA PAID/ETA v 4.0 software.
;
Q
;
; This program will review the TIME & ATTENDANCE RECORDS (#458) file
; from 12/6/2003 through 1/10/2004 looking for employees who were
; eligible for Saturday Premium under the newly passed Public
; Law 108-170 and who worked a tour of duty that would entitle them
; to Saturday Premium pay. A report will be generated for each employee
; meeting this criteria. This report will be delivered to the Central
; PAID group so they can determine if any back pay is due the employee.
;
START ; Define variables
;
N CNT,DATA,DATA0,DATA8,DATA9,DAY,DB,DFN,DTE,EMP,EMPCNT,FLSA,GRD,GS
N I,INT,J,K,L3,L4,LCNT,LINE1,LINE2,NH,OCC,PDT,PP,PPE,PPI,PPI9,PG,PREM
N QT,RPT,SAL,SAT,SEG,SSN,STAT,STEP,TC,TL,TOT,U,WRK,Y3,Y31,Y4
K ^TMP($J,"P89")
S LCNT=1,$P(LINE1,"-",79)="-",$P(LINE2,"=",79)="=",U="^",(PG,QT)=0
S RPT=1
D OCC
;
PP ; Loop through Pay Period 03-24 - 03-26
;
F I=24:1:26 D
. S PPE="03-"_I
. S PPI=$O(^PRST(458,"B",PPE,0))
. Q:'PPI
. Q:'$D(^PRST(458,PPI,0))
. S PPI9=$O(^PRST(459,"B",PPE,0))
. W !,LINE2
. W !,"= Pay Period ",PPE,?78,"="
. W !,LINE2
. D PPHDR
. ;
EMP . ;Loop through employees
. ;
. S (DFN,EMP,EMPCNT)=0
. F S EMP=$O(^PRST(458,PPI,"E",EMP)) Q:'EMP D
. . S DATA0=$G(^PRSPC(EMP,0))
. . Q:DATA0=""!(DATA0?1"^"."^")
. . S OCC=$P(DATA0,U,17)
. . Q:OCC="" ; Quit if no OCC code
. . Q:'$D(^TMP($J,"P89","OCC",OCC)) ; Quit if not eligible for Sat Prem
. . S INT=$S($P(DATA0,U,10)=3:1,1:0)
. . S WRK=0
. . D DAY ; Check for work on Saturdays
. . Q:'WRK
. . I $X>78 W ! ; Show patch is working
. . W "."
. . S DFN=EMP ; DFN is needed for call to S1^PRSADP1
. . ; Load employee info from #459 or #450 for header. Load 8B from #458
. . S DATA9=$S(PPI9'="":$G(^PRST(459,PPI9,"P",EMP,0)),1:"")
. . S DATA8=$G(^PRST(458,PPI,"E",EMP,5))
. . S SAL=$P(DATA9,U,14) I SAL="" S SAL="*"_$P(DATA0,U,29)
. . S SSN=$P(DATA9,U,2) I SSN="" S SSN=$P(DATA0,U,9)
. . S SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
. . S PP=$P(DATA9,U,3) I PP="" S PP="*"_$P(DATA0,U,21)
. . S DB=$P(DATA9,U,6) I DB="" S DB="*"_$P(DATA0,U,10)
. . S NH=$P(DATA9,U,7) I NH="" S NH="*"_$P(DATA0,U,16)
. . S TL=$P(DATA9,U,13) I TL="" S TL="*"_$P(DATA0,U,8)
. . S FLSA="*"_$P(DATA0,U,12)
. . S PREM=$P($G(^PRSPC(EMP,"PREMIUM")),U,6)
. . I PREM'="" S PREM="*"_PREM
. . S GRD=$P(DATA9,U,4) I GRD="" S GRD="*"_$P(DATA0,U,14)
. . S STEP=$P(DATA9,U,5) I STEP="" S STEP="*"_$P(DATA0,U,39)
. . S GS=GRD_"/"_STEP
. . D HDR ; Employee header
. . D DIS ; Employee timecard
. . S EMPCNT=EMPCNT+1
. D SETX
. S DATA=LINE2 D SET
. W !!,DATA
. S DATA="= Total Employees reported for PP "_PPE_" : "_EMPCNT
. W !,DATA,?78,"="
. S $E(DATA,68,73)="RPT #"_RPT,$E(DATA,79)="="
. D SET
. S DATA=LINE2 D SET
. W !,DATA
. D SETX,SETX
. W !!
D XMT
K ^TMP($J,"P89")
Q
;
;====================================================================
; Check for any work on either Saturday
DAY F SAT=7,14 D Q:WRK
. ; Check for a scheduled tour on a Saturday.
. I $P($G(^PRST(458,PPI,"E",EMP,"D",SAT,0)),U,2)>2 S WRK=1 Q
. ; Check exceptions for RG, CT, OT or HW
. F SEG=3:4:28 D Q:WRK
. . S TOT=$P($G(^PRST(458,PPI,"E",EMP,"D",SAT,2)),U,SEG)
. . Q:TOT=""
. . I "CTHWOTRG"[TOT S WRK=1
Q
;
PPHDR ; Pay Period header
S DATA=LINE2
D SET
S DATA="= Pay Period "_PPE,$E(DATA,68,73)="RPT #"_RPT,$E(DATA,79)="="
D SET
S DATA=LINE2
D SET,SETX
Q
;
;====================================================================
HDR ; Display Header
; LINE 1
S DATA=$P(DATA0,U,1),$E(DATA,32)=" "
S DATA=DATA_SSN
S $E(DATA,50)=" ",DATA=DATA_"T&L: "_TL
S $E(DATA,61)=" ",DATA=DATA_"OCC: "_OCC
D SET
; LINE 2
S DATA="Sal: "_SAL,$E(DATA,18)=" "
S DATA=DATA_"PP: "_PP,$E(DATA,27)=" "
S DATA=DATA_"DB: "_DB,$E(DATA,36)=" "
S DATA=DATA_"NH: "_NH,$E(DATA,46)=" "
S DATA=DATA_"FLSA: "_FLSA,$E(DATA,58)=" "
S DATA=DATA_"PPI: "_PREM
S $E(DATA,67)=" ",DATA=DATA_"G/S: "_GS
D SET,SETX
Q
;
;====================================================================
DIS ; Display 14 days
;
S PDT=$G(^PRST(458,PPI,2)),STAT=$P($G(^PRST(458,PPI,"E",EMP,0)),"^",2)
S DATA=" Date Scheduled Tour Tour Exceptions"
D SET
S DATA=LINE1
S $E(DATA,1,3)=" "
D SET
F DAY=1:1:14 S DTE=$P(PDT,"^",DAY) D
F0 . ; Display Frames
. K Y1,Y2 S Y1=$G(^PRST(458,PPI,"E",DFN,"D",DAY,1)),Y2=$G(^(2)),Y3=$G(^(3)),Y4=$G(^(4)),TC=$P($G(^(0)),"^",2)
. I Y1="" S Y1=$S(TC=1:"Day Off",TC=2:"Day Tour",TC=3!(TC=4):"Intermittent",1:"")
. I " 1 3 4 "'[TC,$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",1)="" S Y2(1)="Unposted"
. I TC=3,$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",4)=1 S Y2(1)="Day Worked"
. S DATA=" "_DTE
. S (L3,L4)=0
. I Y1="",Y2="" S Y31="" Q
. D S1^PRSADP1
. F K=1:1 Q:'$D(Y1(K))&'$D(Y2(K)) D
. . ; Don't repeat the Date and Tour for days w/ multiple lines
. . I K>1 S DATA="",$E(DATA,45)=" "
. . I $D(Y1(K)) D
. . . S $E(DATA,21)=" "
. . . S DATA=DATA_Y1(K)
. . I $D(Y2(K)) D
. . . S $E(DATA,45)=" "
. . . S DATA=DATA_$P(Y2(K),U,1)
. . . S $E(DATA,63)=" "
. . . S DATA=DATA_$P(Y2(K),U,2)
. . D SET
. . I Y3'="" S DATA=" "_Y3 D SET
D SETX
S DATA=" 8B: "_DATA8
D SET,SETX
S DATA=LINE1
D SET,SETX
I LCNT>1000 D XMT,PPHDR
Q
;
;====================================================================
SET S ^TMP($J,"P89","DATA",LCNT)=DATA,LCNT=LCNT+1
Q
;
;====================================================================
SETX S ^TMP($J,"P89","DATA",LCNT)="",LCNT=LCNT+1
Q
;
;====================================================================
XMT ; Send TOD information via mail message
I $D(^TMP($J,"P89","DATA")) D
. K DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
. N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
. S XMSUB="PRS*4.0*89 Saturday Premium Report # "_RPT
. S XMDUZ=.5
. S XMTEXT="^TMP($J,""P89"",""DATA"","
. S XMY(DUZ)=""
. D ^XMD
. K ^TMP($J,"P89","DATA")
. S LCNT=1,RPT=RPT+1
Q
;
;====================================================================
OCC ; Set valid OCC codes into ^TMP($J,"P89"
;
F J="02","03","04","05","07",11,25,26,85,86,87,92,96,97,98 D
. S ^TMP($J,"P89","OCC","0180"_J)="" ; PSYCHOLOGISTS
;
F J="02","03","04","05",51,57,58,59,61,62,63,71 D
. S ^TMP($J,"P89","OCC","0185"_J)="" ; SOCIAL WORKER
;
S ^TMP($J,"P89","OCC","060113")="" ; NUCLEAR MEDICINE
;
F J=18,20,59,61 D
. S ^TMP($J,"P89","OCC","0630"_J)="" ; DIETITIAN
;
S ^TMP($J,"P89","OCC","063502")="" ; CORRECTIVE THERAPIST
;
F J=15:1:18 D
. S ^TMP($J,"P89","OCC","0636"_J)="" ; THERAPY ASSISTANTS
;
F J="02","03","05" D
. S ^TMP($J,"P89","OCC","0644"_J)="" ; MEDICAL TECHNOLOGIST
;
F J=11:1:17 D
. S ^TMP($J,"P89","OCC","0647"_J)="" ; DIAGNOSTIC RADIOLOGIC
;
F J=14:1:17 D
. S ^TMP($J,"P89","OCC","0648"_J)="" ; THERAPEUTIC RADIOLOGIC
;
F J=15:1:19,21:1:25,27,28 D
. S ^TMP($J,"P89","OCC","0649"_J)="" ; MEDICAL INSTRUMENT TECHNICIAN
;
F J="03","04","06","07","08","09" D
. S ^TMP($J,"P89","OCC","0661"_J)="" ; PHARMACY AID/TECHNICIAN
;
F J="02","05","08",12,15,18,65,68,75,82 D
. S ^TMP($J,"P89","OCC","0665"_J)="" ; AUDIOLOGIST/SPEECH
;
F J="02",12,22 D
. S ^TMP($J,"P89","OCC","0667"_J)="" ; ORTHOTISTS
;
F J="03","04","05" D
. S ^TMP($J,"P89","OCC","0669"_J)="" ; MEDICAL RECORDS ADMINSTRATION
;
F J="05","06" D
. S ^TMP($J,"P89","OCC","0672"_J)="" ; PROSTHETIC
;
F J="01","02","04","05","06","08","09" D
. S ^TMP($J,"P89","OCC","0675"_J)="" ; MEDICAL RECORDS TECHNICIAN
;
F J="03","04","05","06","07","09",42,45,48 D
. S ^TMP($J,"P89","OCC","0681"_J)="" ; DENTAL ASSISTANT
;
S ^TMP($J,"P89","OCC","068202")="" ; DENTAL HYGIENIST
;
F J="02","03","04" D
. S ^TMP($J,"P89","OCC","0858"_J)="" ; BIOMEDICAL ENGINEER
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSXP89 8078 printed Dec 13, 2024@02:29:05 Page 2
PRSXP89 ;WCIOFO/MGD-Report for Central PAID for PL 108-170 ;03/22/2004
+1 ;;4.0;PAID;**89**;Sep 21, 1995
+2 ;;This routine is not a part of the VistA PAID/ETA v 4.0 software.
+3 ;
+4 QUIT
+5 ;
+6 ; This program will review the TIME & ATTENDANCE RECORDS (#458) file
+7 ; from 12/6/2003 through 1/10/2004 looking for employees who were
+8 ; eligible for Saturday Premium under the newly passed Public
+9 ; Law 108-170 and who worked a tour of duty that would entitle them
+10 ; to Saturday Premium pay. A report will be generated for each employee
+11 ; meeting this criteria. This report will be delivered to the Central
+12 ; PAID group so they can determine if any back pay is due the employee.
+13 ;
START ; Define variables
+1 ;
+2 NEW CNT,DATA,DATA0,DATA8,DATA9,DAY,DB,DFN,DTE,EMP,EMPCNT,FLSA,GRD,GS
+3 NEW I,INT,J,K,L3,L4,LCNT,LINE1,LINE2,NH,OCC,PDT,PP,PPE,PPI,PPI9,PG,PREM
+4 NEW QT,RPT,SAL,SAT,SEG,SSN,STAT,STEP,TC,TL,TOT,U,WRK,Y3,Y31,Y4
+5 KILL ^TMP($JOB,"P89")
+6 SET LCNT=1
SET $PIECE(LINE1,"-",79)="-"
SET $PIECE(LINE2,"=",79)="="
SET U="^"
SET (PG,QT)=0
+7 SET RPT=1
+8 DO OCC
+9 ;
PP ; Loop through Pay Period 03-24 - 03-26
+1 ;
+2 FOR I=24:1:26
Begin DoDot:1
+3 SET PPE="03-"_I
+4 SET PPI=$ORDER(^PRST(458,"B",PPE,0))
+5 if 'PPI
QUIT
+6 if '$DATA(^PRST(458,PPI,0))
QUIT
+7 SET PPI9=$ORDER(^PRST(459,"B",PPE,0))
+8 WRITE !,LINE2
+9 WRITE !,"= Pay Period ",PPE,?78,"="
+10 WRITE !,LINE2
+11 DO PPHDR
+12 ;
EMP ;Loop through employees
+1 ;
+2 SET (DFN,EMP,EMPCNT)=0
+3 FOR
SET EMP=$ORDER(^PRST(458,PPI,"E",EMP))
if 'EMP
QUIT
Begin DoDot:2
+4 SET DATA0=$GET(^PRSPC(EMP,0))
+5 if DATA0=""!(DATA0?1"^"."^")
QUIT
+6 SET OCC=$PIECE(DATA0,U,17)
+7 ; Quit if no OCC code
if OCC=""
QUIT
+8 ; Quit if not eligible for Sat Prem
if '$DATA(^TMP($JOB,"P89","OCC",OCC))
QUIT
+9 SET INT=$SELECT($PIECE(DATA0,U,10)=3:1,1:0)
+10 SET WRK=0
+11 ; Check for work on Saturdays
DO DAY
+12 if 'WRK
QUIT
+13 ; Show patch is working
IF $X>78
WRITE !
+14 WRITE "."
+15 ; DFN is needed for call to S1^PRSADP1
SET DFN=EMP
+16 ; Load employee info from #459 or #450 for header. Load 8B from #458
+17 SET DATA9=$SELECT(PPI9'="":$GET(^PRST(459,PPI9,"P",EMP,0)),1:"")
+18 SET DATA8=$GET(^PRST(458,PPI,"E",EMP,5))
+19 SET SAL=$PIECE(DATA9,U,14)
IF SAL=""
SET SAL="*"_$PIECE(DATA0,U,29)
+20 SET SSN=$PIECE(DATA9,U,2)
IF SSN=""
SET SSN=$PIECE(DATA0,U,9)
+21 SET SSN=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
+22 SET PP=$PIECE(DATA9,U,3)
IF PP=""
SET PP="*"_$PIECE(DATA0,U,21)
+23 SET DB=$PIECE(DATA9,U,6)
IF DB=""
SET DB="*"_$PIECE(DATA0,U,10)
+24 SET NH=$PIECE(DATA9,U,7)
IF NH=""
SET NH="*"_$PIECE(DATA0,U,16)
+25 SET TL=$PIECE(DATA9,U,13)
IF TL=""
SET TL="*"_$PIECE(DATA0,U,8)
+26 SET FLSA="*"_$PIECE(DATA0,U,12)
+27 SET PREM=$PIECE($GET(^PRSPC(EMP,"PREMIUM")),U,6)
+28 IF PREM'=""
SET PREM="*"_PREM
+29 SET GRD=$PIECE(DATA9,U,4)
IF GRD=""
SET GRD="*"_$PIECE(DATA0,U,14)
+30 SET STEP=$PIECE(DATA9,U,5)
IF STEP=""
SET STEP="*"_$PIECE(DATA0,U,39)
+31 SET GS=GRD_"/"_STEP
+32 ; Employee header
DO HDR
+33 ; Employee timecard
DO DIS
+34 SET EMPCNT=EMPCNT+1
End DoDot:2
+35 DO SETX
+36 SET DATA=LINE2
DO SET
+37 WRITE !!,DATA
+38 SET DATA="= Total Employees reported for PP "_PPE_" : "_EMPCNT
+39 WRITE !,DATA,?78,"="
+40 SET $EXTRACT(DATA,68,73)="RPT #"_RPT
SET $EXTRACT(DATA,79)="="
+41 DO SET
+42 SET DATA=LINE2
DO SET
+43 WRITE !,DATA
+44 DO SETX
DO SETX
+45 WRITE !!
End DoDot:1
+46 DO XMT
+47 KILL ^TMP($JOB,"P89")
+48 QUIT
+49 ;
+50 ;====================================================================
+51 ; Check for any work on either Saturday
DAY FOR SAT=7,14
Begin DoDot:1
+1 ; Check for a scheduled tour on a Saturday.
+2 IF $PIECE($GET(^PRST(458,PPI,"E",EMP,"D",SAT,0)),U,2)>2
SET WRK=1
QUIT
+3 ; Check exceptions for RG, CT, OT or HW
+4 FOR SEG=3:4:28
Begin DoDot:2
+5 SET TOT=$PIECE($GET(^PRST(458,PPI,"E",EMP,"D",SAT,2)),U,SEG)
+6 if TOT=""
QUIT
+7 IF "CTHWOTRG"[TOT
SET WRK=1
End DoDot:2
if WRK
QUIT
End DoDot:1
if WRK
QUIT
+8 QUIT
+9 ;
PPHDR ; Pay Period header
+1 SET DATA=LINE2
+2 DO SET
+3 SET DATA="= Pay Period "_PPE
SET $EXTRACT(DATA,68,73)="RPT #"_RPT
SET $EXTRACT(DATA,79)="="
+4 DO SET
+5 SET DATA=LINE2
+6 DO SET
DO SETX
+7 QUIT
+8 ;
+9 ;====================================================================
HDR ; Display Header
+1 ; LINE 1
+2 SET DATA=$PIECE(DATA0,U,1)
SET $EXTRACT(DATA,32)=" "
+3 SET DATA=DATA_SSN
+4 SET $EXTRACT(DATA,50)=" "
SET DATA=DATA_"T&L: "_TL
+5 SET $EXTRACT(DATA,61)=" "
SET DATA=DATA_"OCC: "_OCC
+6 DO SET
+7 ; LINE 2
+8 SET DATA="Sal: "_SAL
SET $EXTRACT(DATA,18)=" "
+9 SET DATA=DATA_"PP: "_PP
SET $EXTRACT(DATA,27)=" "
+10 SET DATA=DATA_"DB: "_DB
SET $EXTRACT(DATA,36)=" "
+11 SET DATA=DATA_"NH: "_NH
SET $EXTRACT(DATA,46)=" "
+12 SET DATA=DATA_"FLSA: "_FLSA
SET $EXTRACT(DATA,58)=" "
+13 SET DATA=DATA_"PPI: "_PREM
+14 SET $EXTRACT(DATA,67)=" "
SET DATA=DATA_"G/S: "_GS
+15 DO SET
DO SETX
+16 QUIT
+17 ;
+18 ;====================================================================
DIS ; Display 14 days
+1 ;
+2 SET PDT=$GET(^PRST(458,PPI,2))
SET STAT=$PIECE($GET(^PRST(458,PPI,"E",EMP,0)),"^",2)
+3 SET DATA=" Date Scheduled Tour Tour Exceptions"
+4 DO SET
+5 SET DATA=LINE1
+6 SET $EXTRACT(DATA,1,3)=" "
+7 DO SET
+8 FOR DAY=1:1:14
SET DTE=$PIECE(PDT,"^",DAY)
Begin DoDot:1
F0 ; Display Frames
+1 KILL Y1,Y2
SET Y1=$GET(^PRST(458,PPI,"E",DFN,"D",DAY,1))
SET Y2=$GET(^(2))
SET Y3=$GET(^(3))
SET Y4=$GET(^(4))
SET TC=$PIECE($GET(^(0)),"^",2)
+2 IF Y1=""
SET Y1=$SELECT(TC=1:"Day Off",TC=2:"Day Tour",TC=3!(TC=4):"Intermittent",1:"")
+3 IF " 1 3 4 "'[TC
IF $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",1)=""
SET Y2(1)="Unposted"
+4 IF TC=3
IF $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",4)=1
SET Y2(1)="Day Worked"
+5 SET DATA=" "_DTE
+6 SET (L3,L4)=0
+7 IF Y1=""
IF Y2=""
SET Y31=""
QUIT
+8 DO S1^PRSADP1
+9 FOR K=1:1
if '$DATA(Y1(K))&'$DATA(Y2(K))
QUIT
Begin DoDot:2
+10 ; Don't repeat the Date and Tour for days w/ multiple lines
+11 IF K>1
SET DATA=""
SET $EXTRACT(DATA,45)=" "
+12 IF $DATA(Y1(K))
Begin DoDot:3
+13 SET $EXTRACT(DATA,21)=" "
+14 SET DATA=DATA_Y1(K)
End DoDot:3
+15 IF $DATA(Y2(K))
Begin DoDot:3
+16 SET $EXTRACT(DATA,45)=" "
+17 SET DATA=DATA_$PIECE(Y2(K),U,1)
+18 SET $EXTRACT(DATA,63)=" "
+19 SET DATA=DATA_$PIECE(Y2(K),U,2)
End DoDot:3
+20 DO SET
+21 IF Y3'=""
SET DATA=" "_Y3
DO SET
End DoDot:2
End DoDot:1
+22 DO SETX
+23 SET DATA=" 8B: "_DATA8
+24 DO SET
DO SETX
+25 SET DATA=LINE1
+26 DO SET
DO SETX
+27 IF LCNT>1000
DO XMT
DO PPHDR
+28 QUIT
+29 ;
+30 ;====================================================================
SET SET ^TMP($JOB,"P89","DATA",LCNT)=DATA
SET LCNT=LCNT+1
+1 QUIT
+2 ;
+3 ;====================================================================
SETX SET ^TMP($JOB,"P89","DATA",LCNT)=""
SET LCNT=LCNT+1
+1 QUIT
+2 ;
+3 ;====================================================================
XMT ; Send TOD information via mail message
+1 IF $DATA(^TMP($JOB,"P89","DATA"))
Begin DoDot:1
+2 KILL DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
+3 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
+4 SET XMSUB="PRS*4.0*89 Saturday Premium Report # "_RPT
+5 SET XMDUZ=.5
+6 SET XMTEXT="^TMP($J,""P89"",""DATA"","
+7 SET XMY(DUZ)=""
+8 DO ^XMD
+9 KILL ^TMP($JOB,"P89","DATA")
+10 SET LCNT=1
SET RPT=RPT+1
End DoDot:1
+11 QUIT
+12 ;
+13 ;====================================================================
OCC ; Set valid OCC codes into ^TMP($J,"P89"
+1 ;
+2 FOR J="02","03","04","05","07",11,25,26,85,86,87,92,96,97,98
Begin DoDot:1
+3 ; PSYCHOLOGISTS
SET ^TMP($JOB,"P89","OCC","0180"_J)=""
End DoDot:1
+4 ;
+5 FOR J="02","03","04","05",51,57,58,59,61,62,63,71
Begin DoDot:1
+6 ; SOCIAL WORKER
SET ^TMP($JOB,"P89","OCC","0185"_J)=""
End DoDot:1
+7 ;
+8 ; NUCLEAR MEDICINE
SET ^TMP($JOB,"P89","OCC","060113")=""
+9 ;
+10 FOR J=18,20,59,61
Begin DoDot:1
+11 ; DIETITIAN
SET ^TMP($JOB,"P89","OCC","0630"_J)=""
End DoDot:1
+12 ;
+13 ; CORRECTIVE THERAPIST
SET ^TMP($JOB,"P89","OCC","063502")=""
+14 ;
+15 FOR J=15:1:18
Begin DoDot:1
+16 ; THERAPY ASSISTANTS
SET ^TMP($JOB,"P89","OCC","0636"_J)=""
End DoDot:1
+17 ;
+18 FOR J="02","03","05"
Begin DoDot:1
+19 ; MEDICAL TECHNOLOGIST
SET ^TMP($JOB,"P89","OCC","0644"_J)=""
End DoDot:1
+20 ;
+21 FOR J=11:1:17
Begin DoDot:1
+22 ; DIAGNOSTIC RADIOLOGIC
SET ^TMP($JOB,"P89","OCC","0647"_J)=""
End DoDot:1
+23 ;
+24 FOR J=14:1:17
Begin DoDot:1
+25 ; THERAPEUTIC RADIOLOGIC
SET ^TMP($JOB,"P89","OCC","0648"_J)=""
End DoDot:1
+26 ;
+27 FOR J=15:1:19,21:1:25,27,28
Begin DoDot:1
+28 ; MEDICAL INSTRUMENT TECHNICIAN
SET ^TMP($JOB,"P89","OCC","0649"_J)=""
End DoDot:1
+29 ;
+30 FOR J="03","04","06","07","08","09"
Begin DoDot:1
+31 ; PHARMACY AID/TECHNICIAN
SET ^TMP($JOB,"P89","OCC","0661"_J)=""
End DoDot:1
+32 ;
+33 FOR J="02","05","08",12,15,18,65,68,75,82
Begin DoDot:1
+34 ; AUDIOLOGIST/SPEECH
SET ^TMP($JOB,"P89","OCC","0665"_J)=""
End DoDot:1
+35 ;
+36 FOR J="02",12,22
Begin DoDot:1
+37 ; ORTHOTISTS
SET ^TMP($JOB,"P89","OCC","0667"_J)=""
End DoDot:1
+38 ;
+39 FOR J="03","04","05"
Begin DoDot:1
+40 ; MEDICAL RECORDS ADMINSTRATION
SET ^TMP($JOB,"P89","OCC","0669"_J)=""
End DoDot:1
+41 ;
+42 FOR J="05","06"
Begin DoDot:1
+43 ; PROSTHETIC
SET ^TMP($JOB,"P89","OCC","0672"_J)=""
End DoDot:1
+44 ;
+45 FOR J="01","02","04","05","06","08","09"
Begin DoDot:1
+46 ; MEDICAL RECORDS TECHNICIAN
SET ^TMP($JOB,"P89","OCC","0675"_J)=""
End DoDot:1
+47 ;
+48 FOR J="03","04","05","06","07","09",42,45,48
Begin DoDot:1
+49 ; DENTAL ASSISTANT
SET ^TMP($JOB,"P89","OCC","0681"_J)=""
End DoDot:1
+50 ;
+51 ; DENTAL HYGIENIST
SET ^TMP($JOB,"P89","OCC","068202")=""
+52 ;
+53 FOR J="02","03","04"
Begin DoDot:1
+54 ; BIOMEDICAL ENGINEER
SET ^TMP($JOB,"P89","OCC","0858"_J)=""
End DoDot:1
+55 ;
+56 QUIT
