source: FOIAVistA/tag/r/PAID-PRS/PRSEPMD4.m@ 1796

Last change on this file since 1796 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1PRSEPMD4 ;HISC/JH-INDIVIDUAL M I DEFICIENCY BY EMPLOYEE ; 9/21/1998
2 ;;4.0;PAID;**20,35,44**;Sep 21, 1995
3EN1 ; 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
7NAME 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
26START ;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
74QUIT ;
75 K ^TMP("PRSE",$J)
76 D CLOSE^PRSEUTL
77 D ^PRSEKILL K POUT
78 Q
79LOOP 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
Note: See TracBrowser for help on using the repository browser.