PRSNRMM1 ;WOIFO-JAH - POC Record and Timecard Mismatches;07/31/09
;;4.0;PAID;**126,142**;Sep 21, 1995;Build 5
;;Per VHA Directive 6402, this routine should not be modified.
Q
;
NURSE ;Nurse view their own mismatch data entry point
N PRSIEN,SSN,X
S PRSIEN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9)
I SSN'="" S PRSIEN=$O(^PRSPC("SSN",SSN,0))
I 'PRSIEN D Q
. W !!,*7
. W "Your SSN was not found in both the New Person & Employee File!"
;
; if not in 450 as a nurse then explain and quit
I +$$ISNURSE^PRSNUT01(PRSIEN)'>0 D NOTNRSDX Q
;
; get pay period and report mismatches
D MAIN(PRSIEN)
Q
;
NOTNRSDX ;
N X
W !!,*7
W ?5,"Your PAID-ETA parameters for your current log on do not reflect"
W !,?5,"the parameters required for Nursing Point of Care Data.",!
S X=$$ASK^PRSLIB00(1)
Q
COORD ;VANOD Site Coordinator entry point
; Coordinator has no access limits so let them pick any nurse
N DIC,X,Y,DUOUT,DTOUT,PRSIEN
S DIC="^PRSPC(",DIC(0)="AEQMZ",DIC("S")="I $$ISNURSE^PRSNUT01(Y)"
D ^DIC
Q:Y'>0!$D(DTOUT)!$D(DUOUT)
S PRSIEN=$P(Y,U)
D MAIN(PRSIEN)
Q
;
DAP ; POC data approval personnel entry point
N GROUP,VALUE,PRSIEN
; prompt DEP to select a group to report on. They must have
; access to the group.
;
D ACCESS^PRSNUT02(.GROUP,"A",DT,0)
;
; quit if any error during group selection
I $P($G(GROUP(0)),U,2)="E" W !!!,?4,$P(GROUP(0),U,3) S X=$$ASK^PRSLIB00(1) Q
S VALUE=+GROUP($O(GROUP(0)))
Q:VALUE'>0
S PRSIEN=+$$PICKNURS^PRSNUT03($P(GROUP(0),U,2),VALUE)
Q:PRSIEN'>0
D MAIN(PRSIEN)
Q
;
DEP ; Entry point for mismatches for Data Entry Personnel.
;
N GROUP,VALUE,PRSIEN
; prompt DEP to select a group to report on. They must have
; access to the group.
;
D ACCESS^PRSNUT02(.GROUP,"E",DT,0)
;
; quit if any error during group selection
I $P($G(GROUP(0)),U,2)="E" W !!!,?4,$P(GROUP(0),U,3) S X=$$ASK^PRSLIB00(1) Q
S VALUE=+GROUP($O(GROUP(0)))
Q:VALUE'>0
S PRSIEN=+$$PICKNURS^PRSNUT03($P(GROUP(0),U,2),VALUE)
Q:PRSIEN'>0
D MAIN(PRSIEN)
Q
;
;= = = = = = = = = = = = = = = = = =
;
MAIN(PRSIEN) ;
;
N DIC,X,Y,DUOUT,DTOUT,PPI
MAIN1 ;
S DIC="^PRSN(451,",DIC(0)="AEQMZ"
S DIC("A")="Select a Pay Period: "
D ^DIC
Q:$D(DUOUT)!$D(DTOUT)
I $G(Y)'>0 W $C(7)," Invalid Pay Period" G MAIN1
S PPI=+Y
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="PRSN POC/ETA MISMATCH REPORT"
. S ZTRTN="REP^PRSNRMM1"
. S ZTSAVE("PRSIEN")=""
. S ZTSAVE("PPI")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
E D
. D REP
Q
;
REP ;
U IO
D PPMM^PRSNRMM(PRSIEN,PPI)
W !!,"End of Report"
D ^%ZISC
Q
;
TL ;Entry point for T&L Unit report
; Report has no access limits so let them pick any T&L group
N GROUP
D PIKGROUP^PRSNUT04(.GROUP,"T",1)
; quit if any error during group selection
I $P($G(GROUP(0)),U,2)="E" D Q
.W !,$P(GROUP(0),U,3)
D TLMAIN
Q
;
TLMAIN ;
;
N DIC,X,Y,DUOUT,DTOUT,PPI
TLMAIN1 ;
S DIC="^PRSN(451,",DIC(0)="AEQMZ"
S DIC("A")="Select a Pay Period: "
D ^DIC
Q:$D(DUOUT)!$D(DTOUT)
I $G(Y)'>0 W $C(7)," Invalid Pay Period" G TLMAIN1
S PPI=+Y
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="PRSN POC/ETA MISMATCH REPORT"
. S ZTRTN="MMREP^PRSNRMM1"
. S ZTSAVE("GROUP(")=""
. S ZTSAVE("PPI")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
E D
. D MMREP
Q
;
MMREP ;
N PRSIEN,PRSNG,PRSNARY,PRSNTL,PICK,PG,STOP
K ^TMP($J,"PRSNRMM")
U IO
S (PICK,PG,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,PPI,"E",PRSIEN)) Q:PRSIEN'>0!STOP D
.. S PRSNARY=$G(^PRSPC(PRSIEN,0))
.. S PRSNAME=$P(PRSNARY,U) ;Nurse Name
.. S PRSNTL=$P(PRSNARY,U,8) ;Nurse T&L
.. Q:PRSNTL'=PICK
.. S ^TMP($J,"PRSNRMM",PICK,PRSNAME,PRSIEN)=""
;
S PICK=0
F S PICK=$O(^TMP($J,"PRSNRMM",PICK)) Q:PICK=""!STOP D
. W !!,"T&L UNIT: ",PICK
. S PRSNAME=""
. F S PRSNAME=$O(^TMP($J,"PRSNRMM",PICK,PRSNAME)) Q:PRSNAME=""!STOP D
.. ; Patch PRS*4.0*142 uses "" instead of the PRSIEN variable in the line below. This is to prevent the first entry from being skipped if PRSIEN has a value going in.
.. S PRSIEN=$O(^TMP($J,"PRSNRMM",PICK,PRSNAME,"")) Q:PRSIEN=""!STOP D
... D PPMM^PRSNRMM(PRSIEN,PPI,.PG,.STOP)
;
W !!,"End of Report"
D ^%ZISC
K ^TMP($J,"PRSNRMM")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRMM1 4690 printed Apr 09, 2024@21:27:34 Page 2
PRSNRMM1 ;WOIFO-JAH - POC Record and Timecard Mismatches;07/31/09
+1 ;;4.0;PAID;**126,142**;Sep 21, 1995;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
NURSE ;Nurse view their own mismatch data entry point
+1 NEW PRSIEN,SSN,X
+2 SET PRSIEN=""
SET SSN=$PIECE($GET(^VA(200,DUZ,1)),"^",9)
+3 IF SSN'=""
SET PRSIEN=$ORDER(^PRSPC("SSN",SSN,0))
+4 IF 'PRSIEN
Begin DoDot:1
+5 WRITE !!,*7
+6 WRITE "Your SSN was not found in both the New Person & Employee File!"
End DoDot:1
QUIT
+7 ;
+8 ; if not in 450 as a nurse then explain and quit
+9 IF +$$ISNURSE^PRSNUT01(PRSIEN)'>0
DO NOTNRSDX
QUIT
+10 ;
+11 ; get pay period and report mismatches
+12 DO MAIN(PRSIEN)
+13 QUIT
+14 ;
NOTNRSDX ;
+1 NEW X
+2 WRITE !!,*7
+3 WRITE ?5,"Your PAID-ETA parameters for your current log on do not reflect"
+4 WRITE !,?5,"the parameters required for Nursing Point of Care Data.",!
+5 SET X=$$ASK^PRSLIB00(1)
+6 QUIT
COORD ;VANOD Site Coordinator entry point
+1 ; Coordinator has no access limits so let them pick any nurse
+2 NEW DIC,X,Y,DUOUT,DTOUT,PRSIEN
+3 SET DIC="^PRSPC("
SET DIC(0)="AEQMZ"
SET DIC("S")="I $$ISNURSE^PRSNUT01(Y)"
+4 DO ^DIC
+5 if Y'>0!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 SET PRSIEN=$PIECE(Y,U)
+7 DO MAIN(PRSIEN)
+8 QUIT
+9 ;
DAP ; POC data approval personnel entry point
+1 NEW GROUP,VALUE,PRSIEN
+2 ; prompt DEP to select a group to report on. They must have
+3 ; access to the group.
+4 ;
+5 DO ACCESS^PRSNUT02(.GROUP,"A",DT,0)
+6 ;
+7 ; quit if any error during group selection
+8 IF $PIECE($GET(GROUP(0)),U,2)="E"
WRITE !!!,?4,$PIECE(GROUP(0),U,3)
SET X=$$ASK^PRSLIB00(1)
QUIT
+9 SET VALUE=+GROUP($ORDER(GROUP(0)))
+10 if VALUE'>0
QUIT
+11 SET PRSIEN=+$$PICKNURS^PRSNUT03($PIECE(GROUP(0),U,2),VALUE)
+12 if PRSIEN'>0
QUIT
+13 DO MAIN(PRSIEN)
+14 QUIT
+15 ;
DEP ; Entry point for mismatches for Data Entry Personnel.
+1 ;
+2 NEW GROUP,VALUE,PRSIEN
+3 ; prompt DEP to select a group to report on. They must have
+4 ; access to the group.
+5 ;
+6 DO ACCESS^PRSNUT02(.GROUP,"E",DT,0)
+7 ;
+8 ; quit if any error during group selection
+9 IF $PIECE($GET(GROUP(0)),U,2)="E"
WRITE !!!,?4,$PIECE(GROUP(0),U,3)
SET X=$$ASK^PRSLIB00(1)
QUIT
+10 SET VALUE=+GROUP($ORDER(GROUP(0)))
+11 if VALUE'>0
QUIT
+12 SET PRSIEN=+$$PICKNURS^PRSNUT03($PIECE(GROUP(0),U,2),VALUE)
+13 if PRSIEN'>0
QUIT
+14 DO MAIN(PRSIEN)
+15 QUIT
+16 ;
+17 ;= = = = = = = = = = = = = = = = = =
+18 ;
MAIN(PRSIEN) ;
+1 ;
+2 NEW DIC,X,Y,DUOUT,DTOUT,PPI
MAIN1 ;
+1 SET DIC="^PRSN(451,"
SET DIC(0)="AEQMZ"
+2 SET DIC("A")="Select a Pay Period: "
+3 DO ^DIC
+4 if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+5 IF $GET(Y)'>0
WRITE $CHAR(7)," Invalid Pay Period"
GOTO MAIN1
+6 SET PPI=+Y
+7 NEW %ZIS,POP,IOP
+8 SET %ZIS="MQ"
+9 DO ^%ZIS
+10 if POP
QUIT
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 KILL IO("Q")
+13 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+14 SET ZTDESC="PRSN POC/ETA MISMATCH REPORT"
+15 SET ZTRTN="REP^PRSNRMM1"
+16 SET ZTSAVE("PRSIEN")=""
+17 SET ZTSAVE("PPI")=""
+18 DO ^%ZTLOAD
+19 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" Queued."
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 DO REP
End DoDot:1
+22 QUIT
+23 ;
REP ;
+1 USE IO
+2 DO PPMM^PRSNRMM(PRSIEN,PPI)
+3 WRITE !!,"End of Report"
+4 DO ^%ZISC
+5 QUIT
+6 ;
TL ;Entry point for T&L Unit report
+1 ; Report has no access limits so let them pick any T&L group
+2 NEW GROUP
+3 DO PIKGROUP^PRSNUT04(.GROUP,"T",1)
+4 ; quit if any error during group selection
+5 IF $PIECE($GET(GROUP(0)),U,2)="E"
Begin DoDot:1
+6 WRITE !,$PIECE(GROUP(0),U,3)
End DoDot:1
QUIT
+7 DO TLMAIN
+8 QUIT
+9 ;
TLMAIN ;
+1 ;
+2 NEW DIC,X,Y,DUOUT,DTOUT,PPI
TLMAIN1 ;
+1 SET DIC="^PRSN(451,"
SET DIC(0)="AEQMZ"
+2 SET DIC("A")="Select a Pay Period: "
+3 DO ^DIC
+4 if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+5 IF $GET(Y)'>0
WRITE $CHAR(7)," Invalid Pay Period"
GOTO TLMAIN1
+6 SET PPI=+Y
+7 NEW %ZIS,POP,IOP
+8 SET %ZIS="MQ"
+9 DO ^%ZIS
+10 if POP
QUIT
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 KILL IO("Q")
+13 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+14 SET ZTDESC="PRSN POC/ETA MISMATCH REPORT"
+15 SET ZTRTN="MMREP^PRSNRMM1"
+16 SET ZTSAVE("GROUP(")=""
+17 SET ZTSAVE("PPI")=""
+18 DO ^%ZTLOAD
+19 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" Queued."
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 DO MMREP
End DoDot:1
+22 QUIT
+23 ;
MMREP ;
+1 NEW PRSIEN,PRSNG,PRSNARY,PRSNTL,PICK,PG,STOP
+2 KILL ^TMP($JOB,"PRSNRMM")
+3 USE IO
+4 SET (PICK,PG,STOP)=0
+5 FOR
SET PICK=$ORDER(GROUP(PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+6 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
+7 SET PRSIEN=0
+8 FOR
SET PRSIEN=$ORDER(^PRSN(451,PPI,"E",PRSIEN))
if PRSIEN'>0!STOP
QUIT
Begin DoDot:2
+9 SET PRSNARY=$GET(^PRSPC(PRSIEN,0))
+10 ;Nurse Name
SET PRSNAME=$PIECE(PRSNARY,U)
+11 ;Nurse T&L
SET PRSNTL=$PIECE(PRSNARY,U,8)
+12 if PRSNTL'=PICK
QUIT
+13 SET ^TMP($JOB,"PRSNRMM",PICK,PRSNAME,PRSIEN)=""
End DoDot:2
End DoDot:1
+14 ;
+15 SET PICK=0
+16 FOR
SET PICK=$ORDER(^TMP($JOB,"PRSNRMM",PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+17 WRITE !!,"T&L UNIT: ",PICK
+18 SET PRSNAME=""
+19 FOR
SET PRSNAME=$ORDER(^TMP($JOB,"PRSNRMM",PICK,PRSNAME))
if PRSNAME=""!STOP
QUIT
Begin DoDot:2
+20 ; Patch PRS*4.0*142 uses "" instead of the PRSIEN variable in the line below. This is to prevent the first entry from being skipped if PRSIEN has a value going in.
+21 SET PRSIEN=$ORDER(^TMP($JOB,"PRSNRMM",PICK,PRSNAME,""))
if PRSIEN=""!STOP
QUIT
Begin DoDot:3
+22 DO PPMM^PRSNRMM(PRSIEN,PPI,.PG,.STOP)
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;
+24 WRITE !!,"End of Report"
+25 DO ^%ZISC
+26 KILL ^TMP($JOB,"PRSNRMM")
+27 QUIT
+28 ;
