PRSEPMD6 ;HISC/GLB-INCOMPLETE MANDATORY INSERVICE CLASS DATA PART 2 OF 2 ;2/17/94
;;4.0;PAID;**20**;Sep 21, 1995
I $O(^TMP("PRSE",$J,"SORT1",""))="" D HDR W !,"NO DEFICIENCIES FOUND FOR THIS TIME PERIOD." W:$G(PSPC)]"" !,"SERVICE: ",PSPC W:$G(PRSECLS)]"" !,"CLASS: ",PRSECLS Q
S (PRSESER,DUEDT)="" F S PRSESER=$O(^TMP("PRSE",$J,"SORT1",PRSESER)) Q:PRSESER=""!(PRSEOUT) D
.S TMP=$G(^TMP("PRSE",$J,"%",PRSESER)),COMPLIAN=""
.S TOT=$P(TMP,U),DEF=$P(TMP,U,2)
.S COMPLIAN=$S(TOT:100-(100*DEF/TOT),1:"")
.I ($Y>(IOSL-8))!'(NSW1) D HDR W ! Q:PRSEOUT
.D SUBHDR
.S NSCT="" F S NSCT=$O(^TMP("PRSE",$J,"SORT1",PRSESER,NSCT)) Q:NSCT=""!(PRSEOUT) S HOLD=1 D S HOLD=1
..S CLASSNUM=+$G(^TMP("PRSE",$J,"SORT1",PRSESER,NSCT)) Q:CLASSNUM'>0
..S NAM="" F S NAM=$O(^TMP("PRSE",$J,"SORT2",CLASSNUM,NAM)) Q:NAM=""!(PRSEOUT) S HOLD2=1 D W ! S HOLD2=1
...S CLASSTXT="" F S CLASSTXT=$O(^TMP("PRSE",$J,"SORT2",CLASSNUM,NAM,CLASSTXT)) Q:CLASSTXT=""!(PRSEOUT) S DUEDT=^(CLASSTXT) D
....I ($Y>(IOSL-8))!'(NSW1) D HDR,SUBHDR W ! Q:PRSEOUT
....I HOLD W $S(NSCT=" BLANK":" ",1:$S(PRSE132:$E(NSCT,1,32),1:$E(NSCT,1,25))),! S HOLD=0
....I HOLD2 W ?10,$S(NAM=" BLANK":" ",1:$S(PRSE132:NAM,1:$E(NAM,1,25))) S HOLD2=0
....W ?40,$$FMTE^XLFDT(DUEDT,2)
....W ?$S(PRSE132:70,1:54),CLASSTXT,!
....S DUEDT="" Q
...Q
..Q
.Q
Q
HDR ; PRINT REPORT HEARDER
I NSW1,$E(IOST)="C" D ENDPG^PRSEUTL S PRSEOUT=+POUT Q:POUT
S COUNT=COUNT+1,(HOLD,NSW1)=1,NSW2=0
W:$E(IOST)="C"!(COUNT>1) @IOF W !,"SERVICE MANDATORY TRAINING DEFICIENCY REPORT FOR "_$S(TYP="C":"CY ",TYP="F":"FY ",1:" ")
W $S(TYP="C"!(TYP="F"):$G(PYR),1:$G(YRST(1))_" - "_$G(YREND(1)))
S Y=DT D:+Y D^DIQ
I PRSE132 D
.W ?101,Y,?121,"PAGE: ",COUNT
.W !!,"TITLE",!,?10,"NAME",?40,"DEFICIENT AS OF",?70,"CLASS"
E D
.W ?68,Y,!?68,"PAGE: ",COUNT
.W !!,"TITLE",?40,"DEFICIENT",!?10,"NAME",?40,"AS OF",?54,"CLASS"
S SE1="",$P(SE1,"-",$S(PRSE132:133,1:81))="" W !,SE1
Q
SUBHDR ;
Q:PRSEOUT
W !,"Service: "_$S(PRSESER=" BLANK":" ",1:PRSESER)
; %Compliance = 100% - ( ( # of deficient persons in the service /
; # of persons in the service ) * 100% )
;# or persons in service=$P(^TMP("PRSE",$J,%,PRSESERV),U)
;# of persons deficient as of date report run("TODAY")=$P(^(PRSESERV),U,2)
W ?50,"% Compliance: ",$J(COMPLIAN,3,0) I COMPLIAN=100,$G(PRSECLS)]"" W ?$X+3,PRSECLS
W !!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEPMD6 2415 printed Apr 09, 2024@21:32:14 Page 2
PRSEPMD6 ;HISC/GLB-INCOMPLETE MANDATORY INSERVICE CLASS DATA PART 2 OF 2 ;2/17/94
+1 ;;4.0;PAID;**20**;Sep 21, 1995
+2 IF $ORDER(^TMP("PRSE",$JOB,"SORT1",""))=""
DO HDR
WRITE !,"NO DEFICIENCIES FOUND FOR THIS TIME PERIOD."
if $GET(PSPC)]""
WRITE !,"SERVICE: ",PSPC
if $GET(PRSECLS)]""
WRITE !,"CLASS: ",PRSECLS
QUIT
+3 SET (PRSESER,DUEDT)=""
FOR
SET PRSESER=$ORDER(^TMP("PRSE",$JOB,"SORT1",PRSESER))
if PRSESER=""!(PRSEOUT)
QUIT
Begin DoDot:1
+4 SET TMP=$GET(^TMP("PRSE",$JOB,"%",PRSESER))
SET COMPLIAN=""
+5 SET TOT=$PIECE(TMP,U)
SET DEF=$PIECE(TMP,U,2)
+6 SET COMPLIAN=$SELECT(TOT:100-(100*DEF/TOT),1:"")
+7 IF ($Y>(IOSL-8))!'(NSW1)
DO HDR
WRITE !
if PRSEOUT
QUIT
+8 DO SUBHDR
+9 SET NSCT=""
FOR
SET NSCT=$ORDER(^TMP("PRSE",$JOB,"SORT1",PRSESER,NSCT))
if NSCT=""!(PRSEOUT)
QUIT
SET HOLD=1
Begin DoDot:2
+10 SET CLASSNUM=+$GET(^TMP("PRSE",$JOB,"SORT1",PRSESER,NSCT))
if CLASSNUM'>0
QUIT
+11 SET NAM=""
FOR
SET NAM=$ORDER(^TMP("PRSE",$JOB,"SORT2",CLASSNUM,NAM))
if NAM=""!(PRSEOUT)
QUIT
SET HOLD2=1
Begin DoDot:3
+12 SET CLASSTXT=""
FOR
SET CLASSTXT=$ORDER(^TMP("PRSE",$JOB,"SORT2",CLASSNUM,NAM,CLASSTXT))
if CLASSTXT=""!(PRSEOUT)
QUIT
SET DUEDT=^(CLASSTXT)
Begin DoDot:4
+13 IF ($Y>(IOSL-8))!'(NSW1)
DO HDR
DO SUBHDR
WRITE !
if PRSEOUT
QUIT
+14 IF HOLD
WRITE $SELECT(NSCT=" BLANK":" ",1:$SELECT(PRSE132:$EXTRACT(NSCT,1,32),1:$EXTRACT(NSCT,1,25))),!
SET HOLD=0
+15 IF HOLD2
WRITE ?10,$SELECT(NAM=" BLANK":" ",1:$SELECT(PRSE132:NAM,1:$EXTRACT(NAM,1,25)))
SET HOLD2=0
+16 WRITE ?40,$$FMTE^XLFDT(DUEDT,2)
+17 WRITE ?$SELECT(PRSE132:70,1:54),CLASSTXT,!
+18 SET DUEDT=""
QUIT
End DoDot:4
+19 QUIT
End DoDot:3
WRITE !
SET HOLD2=1
+20 QUIT
End DoDot:2
SET HOLD=1
+21 QUIT
End DoDot:1
+22 QUIT
HDR ; PRINT REPORT HEARDER
+1 IF NSW1
IF $EXTRACT(IOST)="C"
DO ENDPG^PRSEUTL
SET PRSEOUT=+POUT
if POUT
QUIT
+2 SET COUNT=COUNT+1
SET (HOLD,NSW1)=1
SET NSW2=0
+3 if $EXTRACT(IOST)="C"!(COUNT>1)
WRITE @IOF
WRITE !,"SERVICE MANDATORY TRAINING DEFICIENCY REPORT FOR "_$SELECT(TYP="C":"CY ",TYP="F":"FY ",1:" ")
+4 WRITE $SELECT(TYP="C"!(TYP="F"):$GET(PYR),1:$GET(YRST(1))_" - "_$GET(YREND(1)))
+5 SET Y=DT
if +Y
DO D^DIQ
+6 IF PRSE132
Begin DoDot:1
+7 WRITE ?101,Y,?121,"PAGE: ",COUNT
+8 WRITE !!,"TITLE",!,?10,"NAME",?40,"DEFICIENT AS OF",?70,"CLASS"
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 WRITE ?68,Y,!?68,"PAGE: ",COUNT
+11 WRITE !!,"TITLE",?40,"DEFICIENT",!?10,"NAME",?40,"AS OF",?54,"CLASS"
End DoDot:1
+12 SET SE1=""
SET $PIECE(SE1,"-",$SELECT(PRSE132:133,1:81))=""
WRITE !,SE1
+13 QUIT
SUBHDR ;
+1 if PRSEOUT
QUIT
+2 WRITE !,"Service: "_$SELECT(PRSESER=" BLANK":" ",1:PRSESER)
+3 ; %Compliance = 100% - ( ( # of deficient persons in the service /
+4 ; # of persons in the service ) * 100% )
+5 ;# or persons in service=$P(^TMP("PRSE",$J,%,PRSESERV),U)
+6 ;# of persons deficient as of date report run("TODAY")=$P(^(PRSESERV),U,2)
+7 WRITE ?50,"% Compliance: ",$JUSTIFY(COMPLIAN,3,0)
IF COMPLIAN=100
IF $GET(PRSECLS)]""
WRITE ?$X+3,PRSECLS
+8 WRITE !!
+9 QUIT
