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

PRSEPMD4 ;HISC/JH-INDIVIDUAL M I DEFICIENCY BY EMPLOYEE ; 9/21/1998
 ;;4.0;PAID;**20,35,44**;Sep 21, 1995
EN1 ; DEFICIENCY REPORT FOR SERVICE(S)
 S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
 S (PRSEOUT,NOUT,NQ,NSW1)=0 D EN2^PRSEUTL3(DUZ) I '(PRSESER>0) D MSG3^PRSEMSG G QUIT
 K POUT S DATSEL="NS^N+" D DATSEL^PRSEUTL G:$D(POUT) QUIT
NAME K DIC S DIC("S")="I (+$$EN4^PRSEUTL3($G(DUZ))!(DUZ(0)[""@""!(+$$EN6^PRSEUTL3($G(DUZ))&(+$$EN3^PRSEUTL3(+$G(Y))=PRSESER))))"
 I (+$$EN4^PRSEUTL3($G(DUZ))!(+$$EN6^PRSEUTL3($G(DUZ))!(DUZ(0)["@"))) D
 .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
 E  S DA=DUZ
 I $D(DUOUT)!($D(DTOUT))!'(+Y>0) S POUT=1 G QUIT
 S SSN=$P($G(^VA(200,DA,1)),U,9) S:SSN="" SSN=U
 S DA=$O(^PRSPC("SSN",SSN,0))
 I DA'>0 D  G NAME
 . W !!?5,"No SSN found for this person or, no entry for"
 . W !?5,"this person is found in the PAID EMPLOYEE file (#450)."
 . Q
 I $P($G(^PRSPC(+$G(DA),1)),U,33)="Y" D  G NAME  ;check for separtation IND
 .  W !!?5,"Employee selected is no longer active.  Separation"
 .   W !?5,"Indicator is set to 'Yes'."
 .    Q
 S NAM=$P($G(^PRSPC(DA,0)),U)
 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))
 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"
 W ! S ZTRTN="START^PRSEPMD4",ZTDESC="INDIVIDUAL M.I. DEFICIENCY by EMPLOYEE NAME" D LOOP,DEV^PRSEUTL G:POP!($D(ZTSK)) QUIT
START ;DEFINE FISCAL YEAR DATE AND HEADERS FOR OUTPUT DATA REPORT
 K ^TMP("PRSE",$J) U IO S (HOLD,COUNT)=0,PRSE132=$S(IOM'<132:1,1:0)
 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
 .W:$E(IOST)="C" "."
 .S NSCT="",NSCT=$$EN12^PRSEUTL2($G(PRCOD)) S:NSCT="" NSCT="  BLANK"
 .S NAM=$S($P(^PRSPC(DA,0),U)'="":$P(^(0),U),1:"  BLANK") K DROPDEAD
 .F PURDA=0:0 S PURDA=$O(^PRSPC(DA,6,PURDA)) Q:PURDA'>0  D
 ..S PRSE=$G(^PRSPC(DA,6,PURDA,0)),CLASSIEN=+$P(PRSE,U) Q:CLASSIEN'>0
 ..Q:$S($P(PRSE,U,3)'>0:1,$P(PRSE,U,3)>YREND:1,$P(PRSE,U,3)>DT:1,1:0)
 ..S CLASS=$G(^PRSE(452.1,CLASSIEN,0)) Q:CLASS=""
 ..I $P(CLASS,U,7)'="M" Q  ; Only Mandatory Inservice
 ..S CLASSTXT=$P(CLASS,U),FREQ=+$P(CLASS,U,6)
 ..S CLASSTXT(0)=$S(PRSE132:CLASSTXT,1:$E(CLASSTXT,1,25))
 ..S:CLASSTXT(0)="" CLASSTXT(0)="  BLANK"
 ..;I "^C^F^"[(U_TYP_U),FREQ<1 Q
 ..;I "S"=TYP,FREQ'<1 Q
 ..S DATE=$O(^PRSE(452,"AA","M",VA200DA,CLASSTXT,0))
 ..I FREQ=0,DATE Q  ; ONE TIME ONLY CLASS
 ..S LASTDATE=$S(DATE:9999999-DATE\1,1:0)
 ..I 'LASTDATE S LASTDATE=$P(PRSE,U,3)
 ..I $E(LASTDATE,6,7)="00" D
 ...N MONTH,YEAR,LEAP
 ...S MONTH=+$E(LASTDATE,4,5),YEAR=1700+$E(LASTDATE,1,3)
 ...S LASTDAY=$P("31^"_(28+$$LEAPYR^PRSLIB00(YEAR))_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)
 ...S LASTDATE=$E(LASTDATE,1,5)_LASTDAY
 ...Q
 ..S X1=LASTDATE,X2=$J(FREQ*365.25,0,0) D C^%DTC
 .. ;$P(PRSE,U,3)=date assigned MI course.  Will use as
 .. ;computation date if course never taken (set to LASTDATE above)
 ..S DROPDEAD=X
 ..; DROPDEAD=last possible date before deliquency
 ..I DROPDEAD>YREND Q
 .. Q:$S(DROPDEAD'<YRST:0,DROPDEAD'>YREND:0,1:1)
 ..S ^TMP("PRSE",$J,"L",CLASSTXT(0),NSCT)=NAM_U_DROPDEAD
 ..Q
 .Q
 I $O(^TMP("PRSE",$J,"L",""))="" D  G QUIT
 .D HDR^PRSEPMD1 W !,"No deficiencies found for '",NAM,"' during this period.",!!
 .Q
 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
 .D:($Y>(IOSL-7))!'(NSW1) HDR^PRSEPMD1 Q:PRSEOUT
 .S NAM=$P(^TMP("PRSE",$J,"L",CLASSTXT,NSCT),U),DROPDEAD=$P(^(NSCT),U,2)
 .W ! W:NAM'="  BLANK"&HOLD=1 $S(PRSE132:NAM,1:$E(NAM,1,23))
 .W:NLOC'="  BLANK"&HOLD=1 ?$S(PRSE132:33,1:20),$E(NLOC,1,$S(PRSE132:22,1:14))
 .W ?$S(PRSE132:56,1:37),$$FMTE^XLFDT(DROPDEAD,2)
 .W:CLASSTXT'="  BLANK" ?$S(PRSE132:79,1:55),CLASSTXT
 .S (HOLD,DROPDEAD)=0
 .Q
QUIT ;
 K ^TMP("PRSE",$J)
 D CLOSE^PRSEUTL
 D ^PRSEKILL K POUT
 Q
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)=""
 Q