Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSNRMM1

PRSNRMM1.m

Go to the documentation of this file. 
  1. PRSNRMM1 ;WOIFO-JAH - POC Record and Timecard Mismatches;07/31/09
  1.  ;;4.0;PAID;**126,142**;Sep 21, 1995;Build 5
  1.  ;;Per VHA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1. NURSE ;Nurse view their own mismatch data entry point
  1.  N PRSIEN,SSN,X
  1.  S PRSIEN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9)
  1.  I SSN'="" S PRSIEN=$O(^PRSPC("SSN",SSN,0))
  1.  I 'PRSIEN D  Q
  1.  .  W !!,*7
  1.  .  W "Your SSN was not found in both the New Person & Employee File!"
  1.  ;
  1.  ; if not in 450 as a nurse then explain and quit
  1.  I +$$ISNURSE^PRSNUT01(PRSIEN)'>0 D NOTNRSDX  Q
  1.  ;
  1.  ; get pay period and report mismatches
  1.  D MAIN(PRSIEN)
  1.  Q
  1.  ;
  1. NOTNRSDX ;
  1.  N X
  1.  W !!,*7
  1.  W ?5,"Your PAID-ETA parameters for your current log on do not reflect"
  1.  W !,?5,"the parameters required for Nursing Point of Care Data.",!
  1.  S X=$$ASK^PRSLIB00(1)
  1.  Q
  1. COORD ;VANOD Site Coordinator entry point
  1.  ; Coordinator has no access limits so let them pick any nurse
  1.  N DIC,X,Y,DUOUT,DTOUT,PRSIEN
  1.  S DIC="^PRSPC(",DIC(0)="AEQMZ",DIC("S")="I $$ISNURSE^PRSNUT01(Y)"
  1.  D ^DIC
  1.  Q:Y'>0!$D(DTOUT)!$D(DUOUT)
  1.  S PRSIEN=$P(Y,U)
  1.  D MAIN(PRSIEN)
  1.  Q
  1.  ;
  1. DAP ; POC data approval personnel entry point
  1.  N GROUP,VALUE,PRSIEN
  1.  ; prompt DEP to select a group to report on.  They must have
  1.  ; access to the group.
  1.  ;
  1.  D ACCESS^PRSNUT02(.GROUP,"A",DT,0)
  1.  ;
  1.  ; quit if any error during group selection
  1.  I $P($G(GROUP(0)),U,2)="E" W !!!,?4,$P(GROUP(0),U,3) S X=$$ASK^PRSLIB00(1) Q
  1.  S VALUE=+GROUP($O(GROUP(0)))
  1.  Q:VALUE'>0
  1.  S PRSIEN=+$$PICKNURS^PRSNUT03($P(GROUP(0),U,2),VALUE)
  1.  Q:PRSIEN'>0
  1.  D MAIN(PRSIEN)
  1.  Q
  1.  ;
  1. DEP ; Entry point for mismatches for Data Entry Personnel.
  1.  ;
  1.  N GROUP,VALUE,PRSIEN
  1.  ; prompt DEP to select a group to report on.  They must have
  1.  ; access to the group.
  1.  ;
  1.  D ACCESS^PRSNUT02(.GROUP,"E",DT,0)
  1.  ;
  1.  ; quit if any error during group selection
  1.  I $P($G(GROUP(0)),U,2)="E" W !!!,?4,$P(GROUP(0),U,3) S X=$$ASK^PRSLIB00(1) Q
  1.  S VALUE=+GROUP($O(GROUP(0)))
  1.  Q:VALUE'>0
  1.  S PRSIEN=+$$PICKNURS^PRSNUT03($P(GROUP(0),U,2),VALUE)
  1.  Q:PRSIEN'>0
  1.  D MAIN(PRSIEN)
  1.  Q
  1.  ;
  1.  ;= = = = = = = = = = = = = = = = = =
  1.  ;
  1. MAIN(PRSIEN) ;
  1.  ;
  1.  N DIC,X,Y,DUOUT,DTOUT,PPI
  1. MAIN1 ;
  1.  S DIC="^PRSN(451,",DIC(0)="AEQMZ"
  1.  S DIC("A")="Select a Pay Period: "
  1.  D ^DIC
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  I $G(Y)'>0 W $C(7),"  Invalid Pay Period" G MAIN1
  1.  S PPI=+Y
  1.  N %ZIS,POP,IOP
  1.  S %ZIS="MQ"
  1.  D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D
  1.  . K IO("Q")
  1.  . N ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
  1.  . S ZTDESC="PRSN POC/ETA MISMATCH REPORT"
  1.  . S ZTRTN="REP^PRSNRMM1"
  1.  . S ZTSAVE("PRSIEN")=""
  1.  . S ZTSAVE("PPI")=""
  1.  . D ^%ZTLOAD
  1.  . I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
  1.  E  D
  1.  . D REP
  1.  Q
  1.  ;
  1. REP ;
  1.  U IO
  1.  D PPMM^PRSNRMM(PRSIEN,PPI)
  1.  W !!,"End of Report"
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. TL ;Entry point for T&L Unit report
  1.  ; Report has no access limits so let them pick any T&L group
  1.  N GROUP
  1.  D PIKGROUP^PRSNUT04(.GROUP,"T",1)
  1.  ; quit if any error during group selection
  1.  I $P($G(GROUP(0)),U,2)="E" D  Q
  1.  .W !,$P(GROUP(0),U,3)
  1.  D TLMAIN
  1.  Q
  1.  ;
  1. TLMAIN ;
  1.  ;
  1.  N DIC,X,Y,DUOUT,DTOUT,PPI
  1. TLMAIN1 ;
  1.  S DIC="^PRSN(451,",DIC(0)="AEQMZ"
  1.  S DIC("A")="Select a Pay Period: "
  1.  D ^DIC
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  I $G(Y)'>0 W $C(7),"  Invalid Pay Period" G TLMAIN1
  1.  S PPI=+Y
  1.  N %ZIS,POP,IOP
  1.  S %ZIS="MQ"
  1.  D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D
  1.  . K IO("Q")
  1.  . N ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
  1.  . S ZTDESC="PRSN POC/ETA MISMATCH REPORT"
  1.  . S ZTRTN="MMREP^PRSNRMM1"
  1.  . S ZTSAVE("GROUP(")=""
  1.  . S ZTSAVE("PPI")=""
  1.  . D ^%ZTLOAD
  1.  . I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
  1.  E  D
  1.  . D MMREP
  1.  Q
  1.  ;
  1. MMREP ;
  1.  N PRSIEN,PRSNG,PRSNARY,PRSNTL,PICK,PG,STOP
  1.  K ^TMP($J,"PRSNRMM")
  1.  U IO
  1.  S (PICK,PG,STOP)=0
  1.  F  S PICK=$O(GROUP(PICK)) Q:PICK=""!STOP  D
  1.  . S PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
  1.  . S PRSIEN=0
  1.  . F  S PRSIEN=$O(^PRSN(451,PPI,"E",PRSIEN)) Q:PRSIEN'>0!STOP  D
  1.  .. S PRSNARY=$G(^PRSPC(PRSIEN,0))
  1.  .. S PRSNAME=$P(PRSNARY,U)              ;Nurse Name
  1.  .. S PRSNTL=$P(PRSNARY,U,8)             ;Nurse T&L
  1.  .. Q:PRSNTL'=PICK
  1.  .. S ^TMP($J,"PRSNRMM",PICK,PRSNAME,PRSIEN)=""
  1.  ;
  1.  S PICK=0
  1.  F  S PICK=$O(^TMP($J,"PRSNRMM",PICK)) Q:PICK=""!STOP  D
  1.  . W !!,"T&L UNIT: ",PICK
  1.  . S PRSNAME=""
  1.  . F  S PRSNAME=$O(^TMP($J,"PRSNRMM",PICK,PRSNAME)) Q:PRSNAME=""!STOP  D
  1.  .. ; 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.
  1.  .. S PRSIEN=$O(^TMP($J,"PRSNRMM",PICK,PRSNAME,"")) Q:PRSIEN=""!STOP  D
  1.  ... D PPMM^PRSNRMM(PRSIEN,PPI,.PG,.STOP)
  1.  ;
  1.  W !!,"End of Report"
  1.  D ^%ZISC
  1.  K ^TMP($J,"PRSNRMM")
  1.  Q
  1.  ;