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

PRSNRND0.m

Go to the documentation of this file.
  1. PRSNRND0 ;WOIFO/DAM - Non Direct Care Summary by Skill Mix I REPORT;9/10/2009
  1. ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
  1. ;;Per VHA Directive 2004-038, this routine should not be modified
  1. ;
  1. ;
  1. DAP ; Entry point for Data Approval Personnel
  1. N GROUP
  1. D ACCESS^PRSNUT02(.GROUP,"A",DT,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. 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,"",1)
  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,TYPE,BEG,END
  1. S STOP=0
  1. D DATE
  1. Q:STOP
  1. D QUE
  1. Q
  1. ;
  1. REPORT ;for group of location or t&l
  1. ;
  1. N X,PRSIEN,PRSNGLB,PRSNG,GRP,SORT,PRSNGA,PRSNGB,SKILMIX,NUROLE,PICK,PG
  1. U IO
  1. S SORT=$P(GROUP(0),U,2),PG=0,TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
  1. D HDR^PRSNRND1(EXTBEG,EXTEND)
  1. S (PICK,STOP)=0
  1. F S PICK=$O(GROUP(PICK)) Q:PICK="" D
  1. . S PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
  1. . S PRSNGLB=$S($P(PRSNG,U,2)="N":$NA(^NURSF(211.8,"D",$P(PRSNG,U,7))),1:$NA(^PRSPC("ATL"_$P(PRSNG,U,3))))
  1. . S GRP=$P(PRSNG,U,3) ;External form of primary location
  1. . S PRSNGA=""
  1. . F S PRSNGA=$O(@PRSNGLB@(PRSNGA)) QUIT:PRSNGA="" D
  1. .. S PRSNGB=0
  1. .. F S PRSNGB=$O(@PRSNGLB@(PRSNGA,PRSNGB)) QUIT:'PRSNGB D
  1. ... I $P(PRSNG,U,2)="N",+$P(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB) Q
  1. ... S PRSIEN=$S($P(PRSNG,U,2)="N":+$G(^VA(200,PRSNGB,450)),1:PRSNGB)
  1. ... S X=$$ISNURSE^PRSNUT01(PRSIEN)
  1. ... I +X D
  1. .... S NUROLE=$P(X,U,2)
  1. .... D GATHER^PRSNRND1(.SKILMIX,GRP,NUROLE,PRSIEN,BEG,END)
  1. D PRTLP^PRSNRND1(EXTBEG,EXTEND)
  1. W !!,"End of Report"
  1. D ^%ZISC
  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 Q
  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="GROUP WORK SUMMARY BY SKILLMIX"
  1. . S ZTRTN="REPORT^PRSNRND0"
  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