source: FOIAVistA/trunk/r/PAID-PRS/PRSEPMD5.m@ 1397

PRSEPMD5 ;HISC/GLB/JH-INCOMPLETE EMP. M I REPORT ;9/21/1998
 ;;4.0;PAID;**20,35,44**;Sep 21, 1995
 ;
 ;INCOMPLETE EMPLOYEE M I REPORT (BY CLASS) PART 1 OF 2 
 ;
EN1 ; SERVICE EMPLOYEE DEFICIENCY REPORT
 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)&'(DUZ(0)="@") D MSG3^PRSEMSG G QUIT
 K POUT S DATSEL="NS^N+" D DATSEL^PRSEUTL G:$D(POUT) Q
 I '+$$EN4^PRSEUTL3($G(DUZ)),'(DUZ(0)["@") S PSPC=PRSESER("TX"),PSPC(1)=PRSESER G AR
 K DIC D EN3^PRSEUTL1 G:$D(POUT) QUIT
AR S CORGCODE=+$O(^PRSP(454,1,"ORG","C",+$G(PSPC(1)),0))
 S CORGCODE=$TR($P($G(^PRSP(454,1,"ORG",CORGCODE,0)),U),":")
 S DIC("S")="S DATA=$G(^PRSE(452.1,+Y,0)) I $P($G(DATA),U,7)=""M"",($P($G(DATA),U,9)=0!($P($G(DATA),U,8)=PRSESER!(DUZ(0)[""@""!(+$$EN3^PRSEUTL3($G(DUZ))))))" D EN7^PRSEUTL1 G:$D(POUT) Q
 W ! S ZTRTN="START^PRSEPMD5",ZTDESC="EMPLOYEE M.I. DEFICIENCY by PROGRAM/CLASS" D LOOP,DEV^PRSEUTL G Q:POP!($D(ZTSK))
 ;
START ;DEFINE OUTPUT DATE/HEADERS
 S PRSE132=$S(IOM'<132:1,1:0)
 K ^TMP("PRSE",$J) U IO S (HOLD,HOLD1,HOLD2,COUNT)=0,PRSESERV("OLD")=""
 I $G(PSPC(1)) D
 . S PRS454=0
 . F  S PRS454=$O(^PRSP(454,1,"ORG","C",PSPC(1),PRS454)) Q:PRS454'>0  D
 .. S CORGCODE=$TR($P($G(^PRSP(454,1,"ORG",PRS454,0)),U),":")
 .. I CORGCODE]"" D MAINLOOP
 .. Q
 . Q
 E  D
 . F  S CORGCODE=$O(^PRSPC("ACC",CORGCODE)) Q:CORGCODE=""  D MAINLOOP
 . Q
 D ^PRSEPMD6
 ;
QUIT ;KILL LOCAL VARIABLES
Q K ^TMP("PRSE",$J)
 S POUT=+$G(PRSEOUT)
 S:$D(ZTSK) ZTREQ="@" D CLOSE^PRSEUTL
 D ^PRSEKILL K DUEDT
 Q
 ;
MAINLOOP ;
 S DA=0,PRSESERV=$$SERV(CORGCODE),ONESERV=0
 F  S DA=$O(^PRSPC("ACC",CORGCODE,DA)) Q:DA'>0  D
 .S X(0)=$G(^PRSPC(DA,0)),X(1)=$G(^(1)),SSN=$P(X(0),U,9)
 .Q:(SSN="")!($P(X(1),U,33)="Y")
 .S PRDA=+$O(^VA(200,"SSN",SSN,0)) Q:PRDA'>0   ;PRDA=IEN of file 200
 .S PRSENAME=$P(X(0),U) ; name from 450
 .S NSCT="",PRCOD=$S($P(X(0),U,17)'="":$P(X(0),U,17),1:0)
 .S NSCT=$$EN12^PRSEUTL2(PRCOD) S:NSCT="" NSCT="  BLANK"
 .Q:'+$$EN3^PRSEUTL3($G(PRDA))=PRSESER&'(DUZ(0)="@")&'(+$$EN4^PRSEUTL3($G(DUZ)))
 .W:$E(IOST)="C" "."
 .S NAM=$S($P(^VA(200,PRDA,0),U)'="":$P(^(0),U),1:"  BLANK")  ;NAM=200name
 .F D1=0:0 S D1=$O(^PRSPC(DA,6,D1)) Q:D1'>0  D
 ..K DROPDEAD
 ..S PRSE=$G(^PRSPC(DA,6,D1,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)
 ..I 'NSP,PRSECLS=CLASSTXT S ONESERV=1
 ..S CLASSTXT(0)=$S(PRSE132:CLASSTXT,1:$E(CLASSTXT,1,25))
 ..S:CLASSTXT(0)="" CLASSTXT(0)="  BLANK"
 ..I 'NSP,PRSECLS'=CLASSTXT Q
 ..I $D(PSPC(1)),'(+PSPC(1)=+$$EN3^PRSEUTL3($G(PRDA))) Q
 ..I PRSESERV]"",$G(^TMP("PRSE",$J,"DA",DA))'>0  D
 ...S TMP=$G(^TMP("PRSE",$J,"%",PRSESERV)) S:TMP="01" TMP=0 S $P(TMP,U)=$P(TMP,U)+1
 ...S ^TMP("PRSE",$J,"%",PRSESERV)=TMP,^TMP("PRSE",$J,"DA",DA)=1
 ...Q
 ..;I "^C^F^"[(U_TYP_U),FREQ<1 Q
 ..;I "S"=TYP,FREQ'<1 Q
 ..S DATE=+$O(^PRSE(452,"AA","M",PRDA,CLASSTXT,0))
 ..S LASTDATE=$S(DATE:9999999-DATE\1,1:0) ;date last took course
 ..I 'LASTDATE S LASTDATE=$P(PRSE,U,3)
 ..I $E(LASTDATE,6,7)="00" D
 ...N MONTH,YEAR
 ...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 S DROPDEAD=X
 ..I FREQ=0,DATE Q  ; ONE TIME ONLY CLASS
 ..I DROPDEAD>YREND Q
 ..Q:$S(DROPDEAD'<YRST:0,DROPDEAD'>YREND:0,1:1)
 ..I $G(CLASSNUM)'>0 S CLASSNUM=1
 ..S CLASSNUM(0)=+$G(^TMP("PRSE",$J,"SORT1",PRSESERV,NSCT))
 ..I CLASSNUM(0)'>0 D
 ...S CLASSNUM(0)=CLASSNUM,CLASSNUM=CLASSNUM+1
 ...S ^TMP("PRSE",$J,"SORT1",PRSESERV,NSCT)=CLASSNUM(0)
 ...Q
 ..S ^TMP("PRSE",$J,"SORT2",CLASSNUM(0),PRSENAME,CLASSTXT(0))=$G(DROPDEAD)
 ..I PRSESERV]"",$G(^TMP("PRSE",$J,"DA",DA))'>1 D
 ...S TMP=$G(^TMP("PRSE",$J,"%",PRSESERV)) I $G(DROPDEAD)'>$G(DT) S $P(TMP,U,2)=$P(TMP,U,2)+1
 ...;to calculate compliance use TODAY as the date to compute attendance
 ...;see SUBHDR^PRSEPMD6
 ...S ^TMP("PRSE",$J,"%",PRSESERV)=TMP,^TMP("PRSE",$J,"DA",DA)=2
 ...Q
 ..Q
 .Q
 I ($G(NSP)!($G(NSP)'>0&ONESERV)),'$D(^TMP("PRSE",$J,"SORT1",PRSESERV)) D
 .S ^TMP("PRSE",$J,"SORT1",PRSESERV)="",^TMP("PRSE",$J,"%",PRSESERV)="01"
 .Q
 Q
 ;
LOOP F X="PSP","PSPC","PSPC(","CORGCODE","PYR","NSP","PRDA","PRSESE","YRCHK","YRST","YREND","REQWRD","NCAT","NSCAT","NHOS","NWRD","NSW1","NOUT","PRSEOUT","TYP","PRSECLS","PRSECLS(","PRSEDA","PRSECHK","PRSENAM","PRSESER" D
 .  S ZTSAVE(X)=""
 Q
 ;
SERV(COSTCEN) ;
 N NLOC
 S COSTCEN=$E(COSTCEN,1,4)_":"_$E(COSTCEN,5,8)
 S COSTCEN=+$O(^PRSP(454,1,"ORG","B",COSTCEN,0))
 S NLOC=+$P($G(^PRSP(454,1,"ORG",COSTCEN,0)),U,2)
 S NLOC=$P($G(^PRSP(454.1,NLOC,0)),U)
 S:NLOC="" NLOC="  BLANK"
 Q NLOC