| [613] | 1 | PRSEPMD4 ;HISC/JH-INDIVIDUAL M I DEFICIENCY BY EMPLOYEE ; 9/21/1998
|
|---|
| 2 | ;;4.0;PAID;**20,35,44**;Sep 21, 1995
|
|---|
| 3 | EN1 ; DEFICIENCY REPORT FOR SERVICE(S)
|
|---|
| 4 | S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
|
|---|
| 5 | S (PRSEOUT,NOUT,NQ,NSW1)=0 D EN2^PRSEUTL3(DUZ) I '(PRSESER>0) D MSG3^PRSEMSG G QUIT
|
|---|
| 6 | K POUT S DATSEL="NS^N+" D DATSEL^PRSEUTL G:$D(POUT) QUIT
|
|---|
| 7 | NAME K DIC S DIC("S")="I (+$$EN4^PRSEUTL3($G(DUZ))!(DUZ(0)[""@""!(+$$EN6^PRSEUTL3($G(DUZ))&(+$$EN3^PRSEUTL3(+$G(Y))=PRSESER))))"
|
|---|
| 8 | I (+$$EN4^PRSEUTL3($G(DUZ))!(+$$EN6^PRSEUTL3($G(DUZ))!(DUZ(0)["@"))) D
|
|---|
| 9 | .W ! S DIC("A")="Select EMPLOYEE NAME: ",DIC("W")="I $P($G(^VA(200,+Y,1)),U,9)?9N W ?$X+5,$P(^(1),U,9)",DIC(0)="AEMQI",DIC="^VA(200," D ^DIC K DIC S DA=+Y Q
|
|---|
| 10 | E S DA=DUZ
|
|---|
| 11 | I $D(DUOUT)!($D(DTOUT))!'(+Y>0) S POUT=1 G QUIT
|
|---|
| 12 | S SSN=$P($G(^VA(200,DA,1)),U,9) S:SSN="" SSN=U
|
|---|
| 13 | S DA=$O(^PRSPC("SSN",SSN,0))
|
|---|
| 14 | I DA'>0 D G NAME
|
|---|
| 15 | . W !!?5,"No SSN found for this person or, no entry for"
|
|---|
| 16 | . W !?5,"this person is found in the PAID EMPLOYEE file (#450)."
|
|---|
| 17 | . Q
|
|---|
| 18 | I $P($G(^PRSPC(+$G(DA),1)),U,33)="Y" D G NAME ;check for separtation IND
|
|---|
| 19 | . W !!?5,"Employee selected is no longer active. Separation"
|
|---|
| 20 | . W !?5,"Indicator is set to 'Yes'."
|
|---|
| 21 | . Q
|
|---|
| 22 | S NAM=$P($G(^PRSPC(DA,0)),U)
|
|---|
| 23 | S COSTCEN=$P($G(^PRSPC(DA,0)),U,49),COSTCEN=$E(COSTCEN,1,4)_":"_$E(COSTCEN,5,8),COSTCEN=+$O(^PRSP(454,1,"ORG","B",COSTCEN,0))
|
|---|
| 24 | S NLOC=+$P($G(^PRSP(454,1,"ORG",COSTCEN,0)),U,2),NLOC=$P($G(^PRSP(454.1,NLOC,0)),U) S:NLOC="" NLOC=" BLANK"
|
|---|
| 25 | W ! S ZTRTN="START^PRSEPMD4",ZTDESC="INDIVIDUAL M.I. DEFICIENCY by EMPLOYEE NAME" D LOOP,DEV^PRSEUTL G:POP!($D(ZTSK)) QUIT
|
|---|
| 26 | START ;DEFINE FISCAL YEAR DATE AND HEADERS FOR OUTPUT DATA REPORT
|
|---|
| 27 | K ^TMP("PRSE",$J) U IO S (HOLD,COUNT)=0,PRSE132=$S(IOM'<132:1,1:0)
|
|---|
| 28 | I (+DA>0) S PRCOD=$P($G(^PRSPC(DA,0)),U,17),SSN=$P(^PRSPC(DA,0),U,9) I SSN'="" S VA200DA=$O(^VA(200,"SSN",SSN,0)) D
|
|---|
| 29 | .W:$E(IOST)="C" "."
|
|---|
| 30 | .S NSCT="",NSCT=$$EN12^PRSEUTL2($G(PRCOD)) S:NSCT="" NSCT=" BLANK"
|
|---|
| 31 | .S NAM=$S($P(^PRSPC(DA,0),U)'="":$P(^(0),U),1:" BLANK") K DROPDEAD
|
|---|
| 32 | .F PURDA=0:0 S PURDA=$O(^PRSPC(DA,6,PURDA)) Q:PURDA'>0 D
|
|---|
| 33 | ..S PRSE=$G(^PRSPC(DA,6,PURDA,0)),CLASSIEN=+$P(PRSE,U) Q:CLASSIEN'>0
|
|---|
| 34 | ..Q:$S($P(PRSE,U,3)'>0:1,$P(PRSE,U,3)>YREND:1,$P(PRSE,U,3)>DT:1,1:0)
|
|---|
| 35 | ..S CLASS=$G(^PRSE(452.1,CLASSIEN,0)) Q:CLASS=""
|
|---|
| 36 | ..I $P(CLASS,U,7)'="M" Q ; Only Mandatory Inservice
|
|---|
| 37 | ..S CLASSTXT=$P(CLASS,U),FREQ=+$P(CLASS,U,6)
|
|---|
| 38 | ..S CLASSTXT(0)=$S(PRSE132:CLASSTXT,1:$E(CLASSTXT,1,25))
|
|---|
| 39 | ..S:CLASSTXT(0)="" CLASSTXT(0)=" BLANK"
|
|---|
| 40 | ..;I "^C^F^"[(U_TYP_U),FREQ<1 Q
|
|---|
| 41 | ..;I "S"=TYP,FREQ'<1 Q
|
|---|
| 42 | ..S DATE=$O(^PRSE(452,"AA","M",VA200DA,CLASSTXT,0))
|
|---|
| 43 | ..I FREQ=0,DATE Q ; ONE TIME ONLY CLASS
|
|---|
| 44 | ..S LASTDATE=$S(DATE:9999999-DATE\1,1:0)
|
|---|
| 45 | ..I 'LASTDATE S LASTDATE=$P(PRSE,U,3)
|
|---|
| 46 | ..I $E(LASTDATE,6,7)="00" D
|
|---|
| 47 | ...N MONTH,YEAR,LEAP
|
|---|
| 48 | ...S MONTH=+$E(LASTDATE,4,5),YEAR=1700+$E(LASTDATE,1,3)
|
|---|
| 49 | ...S LASTDAY=$P("31^"_(28+$$LEAPYR^PRSLIB00(YEAR))_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)
|
|---|
| 50 | ...S LASTDATE=$E(LASTDATE,1,5)_LASTDAY
|
|---|
| 51 | ...Q
|
|---|
| 52 | ..S X1=LASTDATE,X2=$J(FREQ*365.25,0,0) D C^%DTC
|
|---|
| 53 | .. ;$P(PRSE,U,3)=date assigned MI course. Will use as
|
|---|
| 54 | .. ;computation date if course never taken (set to LASTDATE above)
|
|---|
| 55 | ..S DROPDEAD=X
|
|---|
| 56 | ..; DROPDEAD=last possible date before deliquency
|
|---|
| 57 | ..I DROPDEAD>YREND Q
|
|---|
| 58 | .. Q:$S(DROPDEAD'<YRST:0,DROPDEAD'>YREND:0,1:1)
|
|---|
| 59 | ..S ^TMP("PRSE",$J,"L",CLASSTXT(0),NSCT)=NAM_U_DROPDEAD
|
|---|
| 60 | ..Q
|
|---|
| 61 | .Q
|
|---|
| 62 | I $O(^TMP("PRSE",$J,"L",""))="" D G QUIT
|
|---|
| 63 | .D HDR^PRSEPMD1 W !,"No deficiencies found for '",NAM,"' during this period.",!!
|
|---|
| 64 | .Q
|
|---|
| 65 | S CLASSTXT="" F S CLASSTXT=$O(^TMP("PRSE",$J,"L",CLASSTXT)) Q:CLASSTXT=""!PRSEOUT S NSCT="" F S NSCT=$O(^TMP("PRSE",$J,"L",CLASSTXT,NSCT)) Q:NSCT=""!PRSEOUT D
|
|---|
| 66 | .D:($Y>(IOSL-7))!'(NSW1) HDR^PRSEPMD1 Q:PRSEOUT
|
|---|
| 67 | .S NAM=$P(^TMP("PRSE",$J,"L",CLASSTXT,NSCT),U),DROPDEAD=$P(^(NSCT),U,2)
|
|---|
| 68 | .W ! W:NAM'=" BLANK"&HOLD=1 $S(PRSE132:NAM,1:$E(NAM,1,23))
|
|---|
| 69 | .W:NLOC'=" BLANK"&HOLD=1 ?$S(PRSE132:33,1:20),$E(NLOC,1,$S(PRSE132:22,1:14))
|
|---|
| 70 | .W ?$S(PRSE132:56,1:37),$$FMTE^XLFDT(DROPDEAD,2)
|
|---|
| 71 | .W:CLASSTXT'=" BLANK" ?$S(PRSE132:79,1:55),CLASSTXT
|
|---|
| 72 | .S (HOLD,DROPDEAD)=0
|
|---|
| 73 | .Q
|
|---|
| 74 | QUIT ;
|
|---|
| 75 | K ^TMP("PRSE",$J)
|
|---|
| 76 | D CLOSE^PRSEUTL
|
|---|
| 77 | D ^PRSEKILL K POUT
|
|---|
| 78 | Q
|
|---|
| 79 | LOOP F X="NAM","PYR","PRDA","DA(","PRSESEL","TYP","DA","REQWRD","NCAT","NSCAT","NHOS","NWRD","NSW1","NOUT","PRSEOUT","PRSESER","PRSENAM","YREND","YRST","NLOC" S ZTSAVE(X)=""
|
|---|
| 80 | Q
|
|---|
