PRSNRUR ;WOIFO/KJS - Unapproved POC records report;1-20-2012
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038,this routine should not be modified.
;
Q
;
EN ; Entry point for approval of POC records for a pay period.
N A,B,DAY,DAYREC,DIC,DIR,DIRUT,DSPFLG,GROUP,I,IEN200
N IEN450,NURSNM,PAYPD,PREVPD,PRSD,PRSFLG,PRSIEN,PRSPD,PRSPDE
N PRSPDI,PRSPRM,PRSSTAT,STOP,REC,SEG
D PIKGROUP^PRSNUT04(.GROUP,"",1)
I $P($G(GROUP(0)),U,2)="E" D Q
. W !!,"There are no groups assigned or selected."
;
S PRSPRM=$P(GROUP(0),U,2)
S STOP=0
;
D SETPPD
Q:STOP
D TYPE
Q:STOP
D QUE
Q
;
SETPPD ; back up default of current pay period if it doesn't have any data
;
N DIC,X,Y,DUOUT,DTOUT
S PRSPDI=$O(^PRSN(451,"AEP",""),-1)
S DIC("B")=PRSPDI
S DIC="^PRSN(451,",DIC(0)="AEQMZ"
S DIC("A")="Select a Pay Period: "
S DIC("S")="I $$PPFND^PRSNRUR(+Y)"
D ^DIC
I $D(DUOUT)!$D(DTOUT)!(+$G(Y)'>0) S STOP=1 Q
S PRSPDI=+Y
;
Q
;
PPFND(PPIEN) ;
N FOUND,PICK,DIVI
S FOUND=0
I $D(^PRSN(451,"AEP",PPIEN)) S FOUND=1 Q FOUND
S PICK=0
F S PICK=$O(GROUP(PICK)) Q:'PICK D Q:FOUND
. S DIVI=$P(GROUP(PICK),U,2)
. I $D(^PRSN(451,"ACE",DIVI,PPIEN)) S FOUND=1
Q FOUND
;
TYPE ;Choose summary or detailed group activity report
;
N DIR,DIRUT,X,Y
S DIR(0)="S^S:Summary Report;D:Detailed Report"
S DIR("A")="Enter Selection"
S DIR("?")="Enter whether you want to select a Summary or Detailed Group Activity Report"
D ^DIR
I $D(DIRUT) S STOP=1 Q
S TYPE=Y
Q
;
QUE ;call to generate and display report for individual activity
N %ZIS,POP,IOP
S %ZIS="MQ"
D ^%ZIS
Q:POP
I $D(IO("Q")) D
. K IO("Q")
. N ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
. S ZTDESC="UNAPPROVED POC TIME "_TYPE_" REPORT"
. S ZTRTN="REPORT^PRSNRUR"
. S ZTSAVE("GROUP")=""
. S ZTSAVE("GROUP(")=""
. S ZTSAVE("TYPE")=""
. S ZTSAVE("PRSPDI")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" queued."
E D
. D REPORT
Q
;
REPORT ;for group of location or t&l
;
N PRSIEN,PRSNG,PICK,PG,STOP,PRSPDE,TODAY,PRSNARY,PRSNAME,PRSNTL,IEN200
N TOT,GTOT
K ^TMP($J,"PRSNR")
S PRSPDE=$P(^PRSN(451,PRSPDI,0),U)
U IO
S PG=0,TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
S (PICK,STOP)=0
F S PICK=$O(GROUP(PICK)) Q:PICK=""!STOP D
. S PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
. S PRSIEN=0
. F S PRSIEN=$O(^PRSN(451,"AEP",PRSPDI,PRSIEN)) Q:'PRSIEN D
.. S PRSNARY=$G(^PRSPC(PRSIEN,0))
.. S PRSNAME=$P(PRSNARY,U) ;Nurse Name
.. S PRSNTL=$P(PRSNARY,U,8) ;Nurse T&L
.. S IEN200=$P($G(^PRSPC(PRSIEN,200)),U)
.. I $P(PRSNG,U,2)="N",+$P(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(IEN200) Q
.. I $P(PRSNG,U,2)="T",PICK'=PRSNTL Q
.. S ^TMP($J,"PRSNR",PICK,PRSNAME,PRSIEN,"A")=""
.;
. S DIVI=$P(GROUP(PICK),U,2)
. S PRSIEN=0
. F S PRSIEN=$O(^PRSN(451,"ACE",DIVI,PRSPDI,PRSIEN)) Q:'PRSIEN D
.. S PRSNARY=$G(^PRSPC(PRSIEN,0))
.. S PRSNAME=$P(PRSNARY,U) ;Nurse Name
.. S PRSNTL=$P(PRSNARY,U,8) ;Nurse T&L
.. S IEN200=$P($G(^PRSPC(PRSIEN,200)),U)
.. I $P(PRSNG,U,2)="N",+$P(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(IEN200) Q
.. I $P(PRSNG,U,2)="T",PICK'=PRSNTL Q
.. S ^TMP($J,"PRSNR",PICK,PRSNAME,PRSIEN,"C")=""
;
S PICK="",(GTOT("A"),GTOT("C"))=0
D HDR
F S PICK=$O(^TMP($J,"PRSNR",PICK)) Q:PICK=""!STOP D
. I TYPE="D" D
.. S GHD="Location: "_PICK
.. S TAB=IOM-$L(GHD)/2-5
.. W !!,?TAB,GHD,!
.. W ?TAB F I=1:1:$L(GHD) W "-"
. S PRSNAME="",(TOT("A"),TOT("C"))=0
. F S PRSNAME=$O(^TMP($J,"PRSNR",PICK,PRSNAME)) Q:PRSNAME=""!STOP D
.. S PRSIEN=""
.. F S PRSIEN=$O(^TMP($J,"PRSNR",PICK,PRSNAME,PRSIEN)) Q:PRSIEN=""!STOP D
... S TT=""
... F S TT=$O(^TMP($J,"PRSNR",PICK,PRSNAME,PRSIEN,TT)) Q:TT=""!STOP D
.... S TOT(TT)=TOT(TT)+1,GTOT(TT)=GTOT(TT)+1
.... Q:TYPE'="D"
.... ;detailed report
.... I (IOSL-4)<$Y D HDR
.... Q:STOP
.... W !,PRSNAME W:TT="C" " Corrected"
. W:TYPE="D" !
. W !,"Total for ",PICK,": ",TOT("A")," Corrected: ",TOT("C")
W !!,"Grand Total: ",GTOT("A")," Corrected: ",GTOT("C")
W !!,"End of Report"
D ^%ZISC
D CLEANUP
Q
;
HDR ;
;
I PG>0 S STOP=$$ASK^PRSLIB00()
Q:STOP
W @IOF
S PG=PG+1
W "Unapproved Pay Period POC Records for "
W $S($P(PRSNG,U,2)="N":"Nurse Location",1:"T&L Unit")
W ?66,"Pay Pd: ",PRSPDE,!
W:TYPE="D" "Nurse Name"
W ?35,$S(TYPE="D":"Detail",1:"Summary"),?66,"Page: ",PG,!
F I=1:1:80 W "-"
;
Q
;
CLEANUP ;
K ^TMP($J,"PRSNR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRUR 4542 printed Nov 22, 2024@17:37:39 Page 2
PRSNRUR ;WOIFO/KJS - Unapproved POC records report;1-20-2012
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038,this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; Entry point for approval of POC records for a pay period.
+1 NEW A,B,DAY,DAYREC,DIC,DIR,DIRUT,DSPFLG,GROUP,I,IEN200
+2 NEW IEN450,NURSNM,PAYPD,PREVPD,PRSD,PRSFLG,PRSIEN,PRSPD,PRSPDE
+3 NEW PRSPDI,PRSPRM,PRSSTAT,STOP,REC,SEG
+4 DO PIKGROUP^PRSNUT04(.GROUP,"",1)
+5 IF $PIECE($GET(GROUP(0)),U,2)="E"
Begin DoDot:1
+6 WRITE !!,"There are no groups assigned or selected."
End DoDot:1
QUIT
+7 ;
+8 SET PRSPRM=$PIECE(GROUP(0),U,2)
+9 SET STOP=0
+10 ;
+11 DO SETPPD
+12 if STOP
QUIT
+13 DO TYPE
+14 if STOP
QUIT
+15 DO QUE
+16 QUIT
+17 ;
SETPPD ; back up default of current pay period if it doesn't have any data
+1 ;
+2 NEW DIC,X,Y,DUOUT,DTOUT
+3 SET PRSPDI=$ORDER(^PRSN(451,"AEP",""),-1)
+4 SET DIC("B")=PRSPDI
+5 SET DIC="^PRSN(451,"
SET DIC(0)="AEQMZ"
+6 SET DIC("A")="Select a Pay Period: "
+7 SET DIC("S")="I $$PPFND^PRSNRUR(+Y)"
+8 DO ^DIC
+9 IF $DATA(DUOUT)!$DATA(DTOUT)!(+$GET(Y)'>0)
SET STOP=1
QUIT
+10 SET PRSPDI=+Y
+11 ;
+12 QUIT
+13 ;
PPFND(PPIEN) ;
+1 NEW FOUND,PICK,DIVI
+2 SET FOUND=0
+3 IF $DATA(^PRSN(451,"AEP",PPIEN))
SET FOUND=1
QUIT FOUND
+4 SET PICK=0
+5 FOR
SET PICK=$ORDER(GROUP(PICK))
if 'PICK
QUIT
Begin DoDot:1
+6 SET DIVI=$PIECE(GROUP(PICK),U,2)
+7 IF $DATA(^PRSN(451,"ACE",DIVI,PPIEN))
SET FOUND=1
End DoDot:1
if FOUND
QUIT
+8 QUIT FOUND
+9 ;
TYPE ;Choose summary or detailed group activity report
+1 ;
+2 NEW DIR,DIRUT,X,Y
+3 SET DIR(0)="S^S:Summary Report;D:Detailed Report"
+4 SET DIR("A")="Enter Selection"
+5 SET DIR("?")="Enter whether you want to select a Summary or Detailed Group Activity Report"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET STOP=1
QUIT
+8 SET TYPE=Y
+9 QUIT
+10 ;
QUE ;call to generate and display report for individual activity
+1 NEW %ZIS,POP,IOP
+2 SET %ZIS="MQ"
+3 DO ^%ZIS
+4 if POP
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 KILL IO("Q")
+7 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+8 SET ZTDESC="UNAPPROVED POC TIME "_TYPE_" REPORT"
+9 SET ZTRTN="REPORT^PRSNRUR"
+10 SET ZTSAVE("GROUP")=""
+11 SET ZTSAVE("GROUP(")=""
+12 SET ZTSAVE("TYPE")=""
+13 SET ZTSAVE("PRSPDI")=""
+14 DO ^%ZTLOAD
+15 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" queued."
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 DO REPORT
End DoDot:1
+18 QUIT
+19 ;
REPORT ;for group of location or t&l
+1 ;
+2 NEW PRSIEN,PRSNG,PICK,PG,STOP,PRSPDE,TODAY,PRSNARY,PRSNAME,PRSNTL,IEN200
+3 NEW TOT,GTOT
+4 KILL ^TMP($JOB,"PRSNR")
+5 SET PRSPDE=$PIECE(^PRSN(451,PRSPDI,0),U)
+6 USE IO
+7 SET PG=0
SET TODAY=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+8 SET (PICK,STOP)=0
+9 FOR
SET PICK=$ORDER(GROUP(PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+10 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
+11 SET PRSIEN=0
+12 FOR
SET PRSIEN=$ORDER(^PRSN(451,"AEP",PRSPDI,PRSIEN))
if 'PRSIEN
QUIT
Begin DoDot:2
+13 SET PRSNARY=$GET(^PRSPC(PRSIEN,0))
+14 ;Nurse Name
SET PRSNAME=$PIECE(PRSNARY,U)
+15 ;Nurse T&L
SET PRSNTL=$PIECE(PRSNARY,U,8)
+16 SET IEN200=$PIECE($GET(^PRSPC(PRSIEN,200)),U)
+17 IF $PIECE(PRSNG,U,2)="N"
IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(IEN200)
QUIT
+18 IF $PIECE(PRSNG,U,2)="T"
IF PICK'=PRSNTL
QUIT
+19 SET ^TMP($JOB,"PRSNR",PICK,PRSNAME,PRSIEN,"A")=""
End DoDot:2
+20 ;
+21 SET DIVI=$PIECE(GROUP(PICK),U,2)
+22 SET PRSIEN=0
+23 FOR
SET PRSIEN=$ORDER(^PRSN(451,"ACE",DIVI,PRSPDI,PRSIEN))
if 'PRSIEN
QUIT
Begin DoDot:2
+24 SET PRSNARY=$GET(^PRSPC(PRSIEN,0))
+25 ;Nurse Name
SET PRSNAME=$PIECE(PRSNARY,U)
+26 ;Nurse T&L
SET PRSNTL=$PIECE(PRSNARY,U,8)
+27 SET IEN200=$PIECE($GET(^PRSPC(PRSIEN,200)),U)
+28 IF $PIECE(PRSNG,U,2)="N"
IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(IEN200)
QUIT
+29 IF $PIECE(PRSNG,U,2)="T"
IF PICK'=PRSNTL
QUIT
+30 SET ^TMP($JOB,"PRSNR",PICK,PRSNAME,PRSIEN,"C")=""
End DoDot:2
End DoDot:1
+31 ;
+32 SET PICK=""
SET (GTOT("A"),GTOT("C"))=0
+33 DO HDR
+34 FOR
SET PICK=$ORDER(^TMP($JOB,"PRSNR",PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+35 IF TYPE="D"
Begin DoDot:2
+36 SET GHD="Location: "_PICK
+37 SET TAB=IOM-$LENGTH(GHD)/2-5
+38 WRITE !!,?TAB,GHD,!
+39 WRITE ?TAB
FOR I=1:1:$LENGTH(GHD)
WRITE "-"
End DoDot:2
+40 SET PRSNAME=""
SET (TOT("A"),TOT("C"))=0
+41 FOR
SET PRSNAME=$ORDER(^TMP($JOB,"PRSNR",PICK,PRSNAME))
if PRSNAME=""!STOP
QUIT
Begin DoDot:2
+42 SET PRSIEN=""
+43 FOR
SET PRSIEN=$ORDER(^TMP($JOB,"PRSNR",PICK,PRSNAME,PRSIEN))
if PRSIEN=""!STOP
QUIT
Begin DoDot:3
+44 SET TT=""
+45 FOR
SET TT=$ORDER(^TMP($JOB,"PRSNR",PICK,PRSNAME,PRSIEN,TT))
if TT=""!STOP
QUIT
Begin DoDot:4
+46 SET TOT(TT)=TOT(TT)+1
SET GTOT(TT)=GTOT(TT)+1
+47 if TYPE'="D"
QUIT
+48 ;detailed report
+49 IF (IOSL-4)<$Y
DO HDR
+50 if STOP
QUIT
+51 WRITE !,PRSNAME
if TT="C"
WRITE " Corrected"
End DoDot:4
End DoDot:3
End DoDot:2
+52 if TYPE="D"
WRITE !
+53 WRITE !,"Total for ",PICK,": ",TOT("A")," Corrected: ",TOT("C")
End DoDot:1
+54 WRITE !!,"Grand Total: ",GTOT("A")," Corrected: ",GTOT("C")
+55 WRITE !!,"End of Report"
+56 DO ^%ZISC
+57 DO CLEANUP
+58 QUIT
+59 ;
HDR ;
+1 ;
+2 IF PG>0
SET STOP=$$ASK^PRSLIB00()
+3 if STOP
QUIT
+4 WRITE @IOF
+5 SET PG=PG+1
+6 WRITE "Unapproved Pay Period POC Records for "
+7 WRITE $SELECT($PIECE(PRSNG,U,2)="N":"Nurse Location",1:"T&L Unit")
+8 WRITE ?66,"Pay Pd: ",PRSPDE,!
+9 if TYPE="D"
WRITE "Nurse Name"
+10 WRITE ?35,$SELECT(TYPE="D":"Detail",1:"Summary"),?66,"Page: ",PG,!
+11 FOR I=1:1:80
WRITE "-"
+12 ;
+13 QUIT
+14 ;
CLEANUP ;
+1 KILL ^TMP($JOB,"PRSNR")
+2 QUIT
