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

PRSNUT05.m

Go to the documentation of this file. 
  1. PRSNUT05 ;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/5/2009
  1.  ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1.  ;
  1. SHOWSU ; SHOW SYSTEM SETUP WITH DIVISIONS, NURSE LOCATIONS AND T&Ls
  1.  ;
  1.  N %ZIS,POP,IOP,DIVMAP,DIVS
  1.  D BLDMAP(.DIVMAP)
  1.  S DIVS=$$SELECT(.DIVMAP)
  1.  Q:DIVS=0
  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 SHOW SYSTEM SETUP REPORT"
  1.  . S ZTRTN="MAIN^PRSNUT05"
  1.  . S ZTSAVE("DIVMAP(")=""
  1.  . S ZTSAVE("DIVS")=""
  1.  . D ^%ZTLOAD
  1.  . I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
  1.  E  D
  1.  . D MAIN
  1.  Q
  1. MAIN ;
  1.  N RUNDT,DATA
  1.  U IO
  1.  S RUNDT=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_(1700+$E(DT,1,3))
  1.  D LOCTL(.DATA,.DIVMAP)
  1.  D SHOLOCTL(.DATA,.DIVMAP,RUNDT)
  1.  D CLEANUP
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. SELECT(DM) ; Allow selection of one or all from division
  1.  N DIC,DUOUT,DTOUT,X,Y
  1.  S DIC="^DIC(4,",DIC(0)="AEQMZ"
  1.  S DIC("S")="I $D(DM(""IN"",+Y))"
  1.  S DIC("A")="Select Division or Return for All: "
  1.  D ^DIC
  1.  I $D(DUOUT)!$D(DTOUT) Q 0
  1.  Q +Y
  1.  ;
  1. LOCTL(DATA,DIVMAP) ;  Build an array that sorts locations with t&ls and counts
  1.  ;  the number of nurses at the location and t&l
  1.  N PRSIEN,X,OUT,NAME,ZNODE,NCNT,TLE,NLDIV,IEN200,NL,NLE,SEPFLAG
  1.  S (NCNT,PRSIEN)=0
  1.  F  S PRSIEN=$O(^PRSPC(PRSIEN)) Q:PRSIEN'>0  D
  1.  . S X=$$ISNURSE^PRSNUT01(PRSIEN)
  1.  . Q:'X
  1.  . S SEPFLAG=$P($G(^PRSPC(PRSIEN,1)),U,33)
  1.  . Q:SEPFLAG="Y"
  1.  . S NCNT=NCNT+1
  1.  . S IEN200=$P($G(^PRSPC(PRSIEN,200)),U)
  1.  . S ZNODE=$G(^PRSPC(PRSIEN,0))
  1.  . S TLE=$P(ZNODE,U,8)
  1.  . I TLE="" S TLE="NONE"
  1.  . S (NL,NLE,NLDIV)="NONE"
  1.  . I IEN200>0 D
  1.  .. S NL=$$PRIMLOC^PRSNUT03(IEN200)
  1.  .. S NLE=$P(NL,U,3)
  1.  .. I NL>0 D
  1.  ... S NLDIV=$P(DIVMAP("NL",+NL),U,3)
  1.  .. E  D
  1.  ... S (NLDIV,NLE)="NONE"
  1.  . I ($G(NLDIV)'="")&($G(NLE)'="")&($G(TLE)'="") D
  1.  .. I NLDIV'="NONE",DIVS'<0,DIVS'=NLDIV Q  ;NOT ALL DIVS OR NOT THE DIV WE'RE LOOKING FOR
  1.  .. I '$D(DATA(NLDIV,NLE,TLE)) S (DATA(NLDIV,NLE,TLE))=0
  1.  .. S DATA(NLDIV,NLE,TLE)=+DATA(NLDIV,NLE,TLE)+1
  1.  Q
  1.  ;
  1. SHOLOCTL(DATA,DIVMAP,RUNDT) ;
  1.  N NLD,LSTNLD,STOP,I,J
  1.  S (NLD,LSTNLD,STOP)=0
  1.  F  S NLD=$O(DATA(NLD)) Q:NLD=""!STOP  D
  1.  .  I NLD'=LSTNLD S:LSTNLD'=0 STOP=$$ASK^PRSLIB00() S LSTNLD=NLD D HDR
  1.  .  S I=""
  1.  .  F  S I=$O(DATA(NLD,I)) Q:I=""  D
  1.  ..   W !,I
  1.  ..   S J=""
  1.  ..   F  S J=$O(DATA(NLD,I,J)) Q:J=""  D
  1.  ...    W !,?25,$G(DATA(NLD,I,J)),?41,J
  1.  ...    I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() D HDR
  1.  Q
  1.  ;
  1. HDR ;
  1.  N K
  1.  W @IOF,!!!?7,"DIVISION: "
  1.  I $G(NLD)="NONE"!($G(NLD)="") D
  1.  .   W NLD
  1.  E  D
  1.  .   W $P(DIVMAP("IN",NLD),U)," (",$P(DIVMAP("IN",NLD),U,2),")"
  1.  W ?(IOM-22),"Run Date: ",RUNDT
  1.  W !,"Location",?22,"Nurse Count",?38,"T&L Unit"
  1.  W ! F K=1:1:IOM W "-"
  1.  Q
  1.  ;
  1. BLDMAP(DIVMAP) ; BUILD A DIVISION MAP OF LOCATIONS
  1.  N DIVINFO,LIEN
  1.  S LIEN=0
  1.  F  S LIEN=$O(^NURSF(211.4,LIEN)) Q:LIEN'>0  D
  1.  .  S DIVINFO=$$DIV^PRSNUT03("N",LIEN)
  1.  .  S DIVMAP("NL",LIEN)=DIVINFO
  1.  .  S DIVMAP("IN",$P(DIVINFO,U,3))=$P(DIVINFO,U,1,2)
  1.  Q
  1. CLEANUP ;
  1.  K DIVMAP,DATA
  1.  Q