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

PRSNRLOS.m

Go to the documentation of this file.
  1. PRSNRLOS ;WOIFO/KJS - All Overtime at a Nursing Location - Summary and Detailed;2-2-2012
  1. ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. COORD ;Entry point for VANOD Coordinator
  1. ; Coordinator has no access limits so let them pick any group
  1. N GROUP
  1. D PIKGROUP^PRSNUT04(.GROUP,"N",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 MAIN
  1. ;
  1. Q
  1. ;
  1. MAIN ;
  1. N RANGE,BEG,END,EXTBEG,EXTEND,STOP
  1. N DAYBEG,DAYEND
  1. N TYPE,BEG,END
  1. S STOP=0
  1. D TYPE
  1. Q:STOP
  1. D DATE
  1. Q:STOP
  1. D QUE
  1. Q
  1. ;
  1. REPORT ;for group of location
  1. ;
  1. N PRSIEN,PRSNG,PICK,PG,LOCIEN,PRSNVER,PRSNTS,PRSNDAY,PPIEN,ENDPP,ENDDAY,BEGPP,BEGDAY,TODAY,PG,TIMEREC
  1. N PRSNAME,PRSNSSN,PRSNTL,SKILMIX,PRSL,PRSNDAYS,PRSNDATE
  1. N PRSNST,PRSNSP,PRSNTT,PRSNWIEN,HOURS,PRSNTIEN
  1. N PRSNTW,PRSNTWD,PRSNM,PRSNRE,PRSNREC,PRSNRIEN,MEAL
  1. N PRSNLNG,IEN200,PRIMLOC,PRSNARY,GHD,SKILTYP,TOTHRS,I
  1. K ^TMP($J,"PRSNR")
  1. U IO
  1. S PG=0,TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
  1. S BEGPP=$G(^PRST(458,"AD",BEG)),BEGDAY=$P(BEGPP,U,2),BEGPP=+BEGPP
  1. S ENDPP=$G(^PRST(458,"AD",END)),ENDDAY=$P(ENDPP,U,2),ENDPP=+ENDPP
  1. S (PICK,STOP)=0
  1. F S PICK=$O(GROUP(PICK)) Q:PICK=""!STOP D
  1. . S PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
  1. . S LOCIEN=+GROUP(PICK)
  1. . S PRSIEN=0
  1. . F S PRSIEN=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN)) Q:'PRSIEN!STOP D
  1. .. D INFO
  1. .. S PPIEN=BEGPP-1
  1. .. F S PPIEN=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN)) Q:'PPIEN!STOP!(PPIEN>ENDPP) D
  1. ... S PRSNDAYS=$G(^PRST(458,PPIEN,1))
  1. ... S PRSNDAY=$S(PPIEN=BEGPP:BEGDAY-1,1:0)
  1. ... F S PRSNDAY=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY)) Q:'PRSNDAY!STOP!(PPIEN=ENDPP&(PRSNDAY>ENDDAY)) D
  1. .... S PRSNDATE=$P(PRSNDAYS,U,PRSNDAY),PRSNDATE=$E(PRSNDATE,4,5)_"/"_$E(PRSNDATE,6,7)_"/"_$E(PRSNDATE,2,3)
  1. .... S PRSNVER=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY,""),-1)
  1. .... S PRSNTS=0,PRSD=1
  1. .... F S PRSNTS=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY,PRSNVER,PRSNTS)) Q:'PRSNTS!STOP D
  1. ..... S TIMEREC=$G(^PRSN(451,PPIEN,"E",PRSIEN,"D",PRSNDAY,"V",PRSNVER,"T",PRSNTS,0))
  1. ..... D DATA
  1. ..... ;NOT overtime so don't proceed
  1. ..... Q:PRSNM=""
  1. ..... I TYPE="S" D TOTTIM1
  1. ..... I TYPE="D" D TOTTIM2
  1. ;
  1. I TYPE="S" D HDRSUM1
  1. I TYPE="D" D HDRSUM2
  1. S PICK=""
  1. F S PICK=$O(^TMP($J,"PRSNR",PICK)) Q:PICK=""!STOP D
  1. . S GHD="Location: "_PICK
  1. . S TAB=IOM-$L(GHD)/2-5
  1. . W !!,?TAB,GHD,!
  1. . W ?TAB F I=1:1:$L(GHD) W "-"
  1. . I TYPE="S" D PRTSUM1
  1. . I TYPE="D" D PRTSUM2
  1. ;
  1. I STOP G EXIT
  1. I TYPE="S" D
  1. . S HOURS=$G(^TMP($J,"PRSNR")),TOTHRS=0
  1. . F I=1:1:3 S TOTHRS=TOTHRS+$P(HOURS,U,I)
  1. . W !,?2,"GRAND TOTAL:",?43,$J($P(HOURS,U,1),7,2),?53,$J($P(HOURS,U,2),7,2),?63,$J($P(HOURS,U,3),7,2),?73,$J(TOTHRS,7,2)
  1. ;
  1. I TYPE="D" D
  1. . S HOURS=$G(^TMP($J,"PRSNR"))
  1. . W !,?2,"GRAND TOTAL:",?66,$J(HOURS,7,2)
  1. ;
  1. EXIT ;
  1. W !!,"End of Report"
  1. D ^%ZISC
  1. K ^TMP($J,"PRSNR")
  1. Q
  1. ;
  1. INFO ;Find nurse information to display in report
  1. ;
  1. S PRSL=1
  1. S PRSNARY=$G(^PRSPC(PRSIEN,0))
  1. S PRSNAME=$P(PRSNARY,U) ;Nurse Name
  1. S PRSNSSN=$P(PRSNARY,U,9) ;Nurse SSN
  1. S PRSNTL=$P(PRSNARY,U,8) ;Nurse T&L
  1. S SKILMIX=$P($$ISNURSE^PRSNUT01(PRSIEN),U,2) ; Nurse skillmix
  1. I SKILMIX["ADMINISTRATIVE" S SKILMIX="ADMIN RN"
  1. S SKILTYP=$S(SKILMIX["RN":1,SKILMIX["LPN":2,1:3)
  1. S IEN200=$G(^PRSPC(PRSIEN,200))
  1. S PRIMLOC=$S(IEN200="":"",1:$$PRIMLOC^PRSNUT03(IEN200))
  1. Q
  1. ;
  1. DATA ;Extract display data from POCD array
  1. ;
  1. ;Start Time
  1. S PRSNST=$P(TIMEREC,U)
  1. ;
  1. ;Stop Time
  1. S PRSNSP=$P(TIMEREC,U,2)
  1. ;
  1. ;Meal Time
  1. S MEAL=$P(TIMEREC,U,3)
  1. ;
  1. ;Get hours worked in a given location
  1. S HOURS=$$AMT^PRSPSAPU(PRSNST,PRSNSP,MEAL)
  1. ;
  1. ;Type of Time code IEN
  1. S PRSNTT=$P(TIMEREC,U,4),PRSNLNG=" "
  1. I PRSNTT'="" D
  1. . ;
  1. . ;Type of Time code
  1. . S PRSNTIEN=$O(^PRST(457.3,"B",PRSNTT,0))
  1. . Q:PRSNTIEN=""
  1. . ;
  1. . ;Description for Type of Time code
  1. . S PRSNLNG=$P(^PRST(457.3,PRSNTIEN,0),U,2)
  1. . ;
  1. . ;Type of Work Code IEN
  1. S PRSNWIEN=$P(TIMEREC,U,6),PRSNTW=" ",PRSNTWD=" "
  1. I PRSNWIEN'="" D
  1. . ;
  1. . ;Type of Work Code
  1. . S PRSNTW=$P(^PRSN(451.5,PRSNWIEN,0),U)
  1. . ;
  1. . ;Description for Type of Work code
  1. . S PRSNTWD=$P(^PRSN(451.5,PRSNWIEN,0),U,2)
  1. ;
  1. ;OT Mandatory/Voluntary
  1. S PRSNM=$P(TIMEREC,U,7)
  1. S PRSNRIEN=$P(TIMEREC,U,8),PRSNREC=" ",PRSNRE=" "
  1. I PRSNRIEN'="" D
  1. . ;Reason for OT code
  1. . S PRSNREC=$P(^PRSN(451.6,PRSNRIEN,0),U)
  1. . ;
  1. . ;Description for OT code
  1. . S PRSNRE=$P(^PRSN(451.6,PRSNRIEN,0),U,2)
  1. Q
  1. ;
  1. TOTTIM1 ;
  1. ; save hours into work array
  1. S $P(^TMP($J,"PRSNR"),U,SKILTYP)=$P($G(^TMP($J,"PRSNR")),U,SKILTYP)+HOURS
  1. S $P(^TMP($J,"PRSNR",PICK),U,SKILTYP)=$P($G(^TMP($J,"PRSNR",PICK)),U,SKILTYP)+HOURS
  1. S $P(^TMP($J,"PRSNR",PICK,3,PRSNTT),U,SKILTYP)=$P($G(^TMP($J,"PRSNR",PICK,3,PRSNTT)),U,SKILTYP)+HOURS
  1. S $P(^TMP($J,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM),U,SKILTYP)=$P($G(^TMP($J,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM)),U,SKILTYP)+HOURS
  1. S $P(^TMP($J,"PRSNR",PICK,1,PRSNRE),U,SKILTYP)=$P($G(^TMP($J,"PRSNR",PICK,1,PRSNRE)),U,SKILTYP)+HOURS
  1. ;
  1. Q
  1. ;
  1. TOTTIM2 ;
  1. ; save hours into work array
  1. S ^TMP($J,"PRSNR")=$G(^TMP($J,"PRSNR"))+HOURS
  1. S ^TMP($J,"PRSNR",PICK)=$G(^TMP($J,"PRSNR",PICK))+HOURS
  1. S ^TMP($J,"PRSNR",PICK,4,PRSNTT)=$G(^TMP($J,"PRSNR",PICK,4,PRSNTT))+HOURS
  1. S ^TMP($J,"PRSNR",PICK,3,PRSNTT_"-"_PRSNM)=$G(^TMP($J,"PRSNR",PICK,3,PRSNTT_"-"_PRSNM))+HOURS
  1. S ^TMP($J,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM_"-"_PRSNREC)=$G(^TMP($J,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM_"-"_PRSNREC))+HOURS
  1. S ^TMP($J,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT_"-"_PRSNM_"-"_PRSNREC_"-"_PRSNTWD)=$G(^TMP($J,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT_"-"_PRSNM_"-"_PRSNREC_"-"_PRSNTWD))+HOURS
  1. ;
  1. Q
  1. ;
  1. HDRSUM1 ;Display header for report of Individual Nurse Activity
  1. ;
  1. W @IOF
  1. S PG=PG+1,PRSL=1
  1. W ?20,"All Overtime at a Nurse Location Summary Report"
  1. W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
  1. W ! ;blank line
  1. W !,?10,"Reason for",?45,"# Of",?55,"# Of",?65,"# Of",?75,"Total"
  1. W !,?10,"Overtime",?45,"Hours",?55,"Hours",?65,"Hours",?75,"Hours"
  1. W !,?46,"RN",?56,"LPN",?66,"UAP"
  1. W !,"--------------------------------------------------------------------------------"
  1. ;
  1. Q
  1. ;
  1. PRTSUM1 ; Loop through Totals array and print each one
  1. ;
  1. N TOTYP
  1. F TOTYP=1:1:3 D Q:STOP
  1. .S PRSNTT=""
  1. .F S PRSNTT=$O(^TMP($J,"PRSNR",PICK,TOTYP,PRSNTT)) Q:PRSNTT=""!STOP D
  1. .. S HOURS=$G(^TMP($J,"PRSNR",PICK,TOTYP,PRSNTT))
  1. .. D PPP1
  1. . W !
  1. Q:STOP
  1. I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM1
  1. Q:STOP
  1. S HOURS=$G(^TMP($J,"PRSNR",PICK)),TOTHRS=0
  1. F I=1:1:3 S TOTHRS=TOTHRS+$P(HOURS,U,I)
  1. W !,?4," TOTAL: ",PICK,?43,$J($P(HOURS,U,1),7,2),?53,$J($P(HOURS,U,2),7,2),?63,$J($P(HOURS,U,3),7,2),?73,$J(TOTHRS,7,2),!
  1. Q
  1. ;
  1. PPP1 ;
  1. S TOTHRS=0
  1. F I=1:1:3 S TOTHRS=TOTHRS+$P(HOURS,U,I)
  1. W !
  1. I TOTYP=1 W ?10,PRSNTT
  1. I TOTYP'=1 W ?10,"TOTAL: ",PRSNTT
  1. W ?43,$J($P(HOURS,U,1),7,2),?53,$J($P(HOURS,U,2),7,2),?63,$J($P(HOURS,U,3),7,2),?73,$J(TOTHRS,7,2)
  1. ;
  1. I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM1
  1. Q
  1. ;
  1. HDRSUM2 ;Display header for report of Individual Nurse Activity
  1. ;
  1. W @IOF
  1. S PG=PG+1,PRSL=1
  1. W ?20,"All Overtime at a Nurse Location Detail Report"
  1. W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
  1. W ! ;blank line
  1. W !,"Nurse Name",?21,"Type Time-",?32,"Type",?48,"Primary Location",?68,"# of",?75,"T&L"
  1. W !,"Skill Mix",?21,"OT-Reason",?32,"Work",?68,"Hours",?75,"Unit"
  1. W !,"--------------------------------------------------------------------------------"
  1. ;
  1. Q
  1. ;
  1. PRTSUM2 ; Loop through Totals array and print each one
  1. ;
  1. N CNT
  1. S PRSNAME=""
  1. F S PRSNAME=$O(^TMP($J,"PRSNR",PICK,1,PRSNAME)) Q:PRSNAME=""!STOP D
  1. . S PRSIEN=""
  1. . F S PRSIEN=$O(^TMP($J,"PRSNR",PICK,1,PRSNAME,PRSIEN)) Q:PRSIEN=""!STOP D
  1. .. D INFO
  1. .. S PRSNTT="",CNT=0
  1. .. F S PRSNTT=$O(^TMP($J,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT)) Q:PRSNTT=""!STOP D
  1. ... S CNT=CNT+1
  1. ... S HOURS=$G(^TMP($J,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT))
  1. ... D PPP2
  1. ..; need a blank line between nurses when there was only one record printed
  1. .. I CNT=1 W !
  1. Q:STOP
  1. I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM2
  1. Q:STOP
  1. D PRTSUM3
  1. Q
  1. ;
  1. PPP2 ;
  1. I PRSL W !,$E(PRSNAME,1,19)
  1. W ?21,$P(PRSNTT,"-",1,3),?32,$E($P(PRSNTT,"-",4),1,14),?48,$E($P(PRIMLOC,U,3),1,18),?67,$J(HOURS,6,2),?75,PRSNTL,!
  1. I PRSL W " ",$E(SKILMIX,1,17)
  1. ;
  1. S PRSL=0
  1. I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM2
  1. Q
  1. ;
  1. PRTSUM3 ; Loop through Totals array and print each one
  1. ;
  1. N TOTYP
  1. F TOTYP=2:1:4 D Q:STOP
  1. .S PRSNTT=""
  1. .F S PRSNTT=$O(^TMP($J,"PRSNR",PICK,TOTYP,PRSNTT)) Q:PRSNTT=""!STOP D
  1. .. S HOURS=$G(^TMP($J,"PRSNR",PICK,TOTYP,PRSNTT))
  1. .. D PPP3
  1. . W !
  1. Q:STOP
  1. I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM2
  1. Q:STOP
  1. S HOURS=$G(^TMP($J,"PRSNR",PICK))
  1. W !,?4," TOTAL: ",PICK,?67,$J(HOURS,6,2),!
  1. Q
  1. ;
  1. PPP3 ;
  1. W !,?6," TOTAL: ",PRSNTT,?67,$J(HOURS,6,2)
  1. ;
  1. I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM2
  1. Q
  1. ;
  1. TYPE ;Choose summary or detailed group activity report
  1. ;
  1. N DIR,DIRUT,X,Y
  1. S DIR(0)="S^S:Summary Report;D:Detailed Report"
  1. S DIR("A")="Enter Selection"
  1. S DIR("?")="Enter whether you want to select a Summary or Detailed Overtime Report"
  1. D ^DIR
  1. I $D(DIRUT) S STOP=1 Q
  1. S TYPE=Y
  1. Q
  1. ;
  1. DATE ; User is prompted for a date range
  1. ;
  1. S RANGE=$$POCRANGE^PRSNUT01()
  1. ; QUIT HERE IF RANGE=0
  1. I +$G(RANGE)'>0 S STOP=1
  1. ;
  1. S BEG=$P(RANGE,U)
  1. S END=$P(RANGE,U,2)
  1. S EXTBEG=$P(RANGE,U,3)
  1. S EXTEND=$P(RANGE,U,4)
  1. ;
  1. Q
  1. ;
  1. QUE ;call to generate and display report for individual activity
  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="All Overtime at a Nurse Location "_$S(TYPE="S":"Summary",1:"Detail")
  1. . S ZTRTN="REPORT^PRSNRLOS"
  1. . S ZTSAVE("GROUP")=""
  1. . S ZTSAVE("GROUP(")=""
  1. . S ZTSAVE("TYPE")=""
  1. . S ZTSAVE("BEG")=""
  1. . S ZTSAVE("END")=""
  1. . S ZTSAVE("EXTBEG")=""
  1. . S ZTSAVE("EXTEND")=""
  1. . D ^%ZTLOAD
  1. . I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" queued."
  1. E D
  1. . D REPORT
  1. Q