- PRSNRND0 ;WOIFO/DAM - Non Direct Care Summary by Skill Mix I REPORT;9/10/2009
- ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
- ;;Per VHA Directive 2004-038, this routine should not be modified
- ;
- ;
- DAP ; Entry point for Data Approval Personnel
- N GROUP
- D ACCESS^PRSNUT02(.GROUP,"A",DT,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 MAIN
- Q
- ;
- COORD ;Entry point for VANOD Coordinator
- ; Coordinator has no access limits so let them pick any group
- N GROUP
- D PIKGROUP^PRSNUT04(.GROUP,"",1)
- I $P($G(GROUP(0)),U,2)="E" D Q
- .W !,$P(GROUP(0),U,3)
- D MAIN
- ;
- Q
- ;
- MAIN ;
- N RANGE,BEG,END,EXTBEG,EXTEND,STOP,TYPE,BEG,END
- S STOP=0
- D DATE
- Q:STOP
- D QUE
- Q
- ;
- REPORT ;for group of location or t&l
- ;
- N X,PRSIEN,PRSNGLB,PRSNG,GRP,SORT,PRSNGA,PRSNGB,SKILMIX,NUROLE,PICK,PG
- U IO
- S SORT=$P(GROUP(0),U,2),PG=0,TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
- D HDR^PRSNRND1(EXTBEG,EXTEND)
- S (PICK,STOP)=0
- F S PICK=$O(GROUP(PICK)) Q:PICK="" D
- . S PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
- . 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))))
- . S GRP=$P(PRSNG,U,3) ;External form of primary location
- . S PRSNGA=""
- . F S PRSNGA=$O(@PRSNGLB@(PRSNGA)) QUIT:PRSNGA="" D
- .. S PRSNGB=0
- .. F S PRSNGB=$O(@PRSNGLB@(PRSNGA,PRSNGB)) QUIT:'PRSNGB D
- ... I $P(PRSNG,U,2)="N",+$P(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB) Q
- ... S PRSIEN=$S($P(PRSNG,U,2)="N":+$G(^VA(200,PRSNGB,450)),1:PRSNGB)
- ... S X=$$ISNURSE^PRSNUT01(PRSIEN)
- ... I +X D
- .... S NUROLE=$P(X,U,2)
- .... D GATHER^PRSNRND1(.SKILMIX,GRP,NUROLE,PRSIEN,BEG,END)
- D PRTLP^PRSNRND1(EXTBEG,EXTEND)
- W !!,"End of Report"
- D ^%ZISC
- Q
- ;
- DATE ; User is prompted for a date range
- ;
- S RANGE=$$POCRANGE^PRSNUT01()
- ; QUIT HERE IF RANGE=0
- I +$G(RANGE)'>0 S STOP=1 Q
- ;
- S BEG=$P(RANGE,U)
- S END=$P(RANGE,U,2)
- S EXTBEG=$P(RANGE,U,3)
- S EXTEND=$P(RANGE,U,4)
- ;
- Q
- ;
- QUE ;call to generate and display report for individual activity
- 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="GROUP WORK SUMMARY BY SKILLMIX"
- . S ZTRTN="REPORT^PRSNRND0"
- . S ZTSAVE("GROUP")=""
- . S ZTSAVE("GROUP(")=""
- . S ZTSAVE("TYPE")=""
- . S ZTSAVE("BEG")=""
- . S ZTSAVE("END")=""
- . S ZTSAVE("EXTBEG")=""
- . S ZTSAVE("EXTEND")=""
- . D ^%ZTLOAD
- . I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
- E D
- . D REPORT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRND0 2564 printed Feb 18, 2025@23:54:02 Page 2
- 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
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified
- +3 ;
- +4 ;
- DAP ; Entry point for Data Approval Personnel
- +1 NEW GROUP
- +2 DO ACCESS^PRSNUT02(.GROUP,"A",DT,1)
- +3 ; quit if any error during group selection
- +4 IF $PIECE($GET(GROUP(0)),U,2)="E"
- Begin DoDot:1
- +5 WRITE !,$PIECE(GROUP(0),U,3)
- End DoDot:1
- QUIT
- +6 DO MAIN
- +7 QUIT
- +8 ;
- COORD ;Entry point for VANOD Coordinator
- +1 ; Coordinator has no access limits so let them pick any group
- +2 NEW GROUP
- +3 DO PIKGROUP^PRSNUT04(.GROUP,"",1)
- +4 IF $PIECE($GET(GROUP(0)),U,2)="E"
- Begin DoDot:1
- +5 WRITE !,$PIECE(GROUP(0),U,3)
- End DoDot:1
- QUIT
- +6 DO MAIN
- +7 ;
- +8 QUIT
- +9 ;
- MAIN ;
- +1 NEW RANGE,BEG,END,EXTBEG,EXTEND,STOP,TYPE,BEG,END
- +2 SET STOP=0
- +3 DO DATE
- +4 if STOP
- QUIT
- +5 DO QUE
- +6 QUIT
- +7 ;
- REPORT ;for group of location or t&l
- +1 ;
- +2 NEW X,PRSIEN,PRSNGLB,PRSNG,GRP,SORT,PRSNGA,PRSNGB,SKILMIX,NUROLE,PICK,PG
- +3 USE IO
- +4 SET SORT=$PIECE(GROUP(0),U,2)
- SET PG=0
- SET TODAY=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
- +5 DO HDR^PRSNRND1(EXTBEG,EXTEND)
- +6 SET (PICK,STOP)=0
- +7 FOR
- SET PICK=$ORDER(GROUP(PICK))
- if PICK=""
- QUIT
- Begin DoDot:1
- +8 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
- +9 SET PRSNGLB=$SELECT($PIECE(PRSNG,U,2)="N":$NAME(^NURSF(211.8,"D",$PIECE(PRSNG,U,7))),1:$NAME(^PRSPC("ATL"_$PIECE(PRSNG,U,3))))
- +10 ;External form of primary location
- SET GRP=$PIECE(PRSNG,U,3)
- +11 SET PRSNGA=""
- +12 FOR
- SET PRSNGA=$ORDER(@PRSNGLB@(PRSNGA))
- if PRSNGA=""
- QUIT
- Begin DoDot:2
- +13 SET PRSNGB=0
- +14 FOR
- SET PRSNGB=$ORDER(@PRSNGLB@(PRSNGA,PRSNGB))
- if 'PRSNGB
- QUIT
- Begin DoDot:3
- +15 IF $PIECE(PRSNG,U,2)="N"
- IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB)
- QUIT
- +16 SET PRSIEN=$SELECT($PIECE(PRSNG,U,2)="N":+$GET(^VA(200,PRSNGB,450)),1:PRSNGB)
- +17 SET X=$$ISNURSE^PRSNUT01(PRSIEN)
- +18 IF +X
- Begin DoDot:4
- +19 SET NUROLE=$PIECE(X,U,2)
- +20 DO GATHER^PRSNRND1(.SKILMIX,GRP,NUROLE,PRSIEN,BEG,END)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 DO PRTLP^PRSNRND1(EXTBEG,EXTEND)
- +22 WRITE !!,"End of Report"
- +23 DO ^%ZISC
- +24 QUIT
- +25 ;
- DATE ; User is prompted for a date range
- +1 ;
- +2 SET RANGE=$$POCRANGE^PRSNUT01()
- +3 ; QUIT HERE IF RANGE=0
- +4 IF +$GET(RANGE)'>0
- SET STOP=1
- QUIT
- +5 ;
- +6 SET BEG=$PIECE(RANGE,U)
- +7 SET END=$PIECE(RANGE,U,2)
- +8 SET EXTBEG=$PIECE(RANGE,U,3)
- +9 SET EXTEND=$PIECE(RANGE,U,4)
- +10 ;
- +11 QUIT
- +12 ;
- QUE ;call to generate and display report for individual activity
- +1 NEW %ZIS,POP,IOP
- +2 SET %ZIS="MQ"
- +3 DO ^%ZIS
- +4 if POP
- QUIT
- +5 IF $DATA(IO("Q"))
- Begin DoDot:1
- +6 KILL IO("Q")
- +7 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
- +8 SET ZTDESC="GROUP WORK SUMMARY BY SKILLMIX"
- +9 SET ZTRTN="REPORT^PRSNRND0"
- +10 SET ZTSAVE("GROUP")=""
- +11 SET ZTSAVE("GROUP(")=""
- +12 SET ZTSAVE("TYPE")=""
- +13 SET ZTSAVE("BEG")=""
- +14 SET ZTSAVE("END")=""
- +15 SET ZTSAVE("EXTBEG")=""
- +16 SET ZTSAVE("EXTEND")=""
- +17 DO ^%ZTLOAD
- +18 IF $DATA(ZTSK)
- SET ZTREQ="@"
- WRITE !,"Request "_ZTSK_" Queued."
- End DoDot:1
- +19 IF '$TEST
- Begin DoDot:1
- +20 DO REPORT
- End DoDot:1
- +21 QUIT