- PRSNRGD0 ;WOIFO/KJS - Nursing LOCATION DETAIL Report ;8/2/2011
- ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
- ;;Per VHA Directive 2004-038, this routine should not be modified
- QUIT
- ;
- 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 ;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="Nursing Location Detail Report"
- . S ZTRTN="REPORT^PRSNRGD0"
- . S ZTSAVE("GROUP(")=""
- . S ZTSAVE("TYPE")=""
- . D ^%ZTLOAD
- . I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
- E D REPORT
- ;
- Q
- ;
- REPORT ;for group of location or t&l
- ;
- N PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG,FTEE,TOTNUR,TOTFTEE
- U IO
- S SORT=$P(GROUP(0),U,2),PG=0,(FTEE,TOTFTEE,TOTNUR)=0
- K ^TMP($J)
- D HDR^PRSNRGD1
- S (PICK,STOP)=0
- F S PICK=$O(GROUP(PICK)) Q:PICK=""!STOP 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))))
- .;
- .;
- .K ^TMP($J)
- .S PRSNGA=""
- .F S PRSNGA=$O(@PRSNGLB@(PRSNGA)) QUIT:PRSNGA=""!STOP D
- ..S PRSNGB=0
- ..F S PRSNGB=$O(@PRSNGLB@(PRSNGA,PRSNGB)) QUIT:'PRSNGB!STOP 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 NURSE=$$ISNURSE^PRSNUT01(PRSIEN)
- ...Q:'+NURSE
- ...S JOB=$$GETCODES^PRSNUT01(PRSIEN) ;Job codes
- ...S BOC=$P(JOB,U)
- ...S OCC=$P(JOB,U,2)
- ...D INFO^PRSNRAS1
- ...S ^TMP($J,OCC,PRSNAME,PRSIEN)=NURSE
- .; display and underline group sub header
- .;
- .Q:STOP
- .S GHD=$S($P(PRSNG,U,2)="N":"LOCATION",1:"T&L UNIT")_": "_$P(PRSNG,U,3)
- .S TAB=IOM-$L(GHD)/2-5
- .W !!,?TAB,GHD,!
- .W ?TAB F I=1:1:$L(GHD) W "-"
- .S S1=""
- .F S S1=$O(^TMP($J,S1)) Q:S1=""!STOP D
- ..S S2=""
- ..F S S2=$O(^TMP($J,S1,S2)) Q:S2=""!STOP D
- ...S PRSIEN=""
- ...F S PRSIEN=$O(^TMP($J,S1,S2,PRSIEN)) Q:PRSIEN=""!STOP D
- ....S NURSE=^TMP($J,S1,S2,PRSIEN)
- ....D DSPLY^PRSNRGD1(PRSIEN,NURSE,.STOP)
- W !!,?40,"Total Nurses: ",$J(TOTNUR,4),?60,"Total FTEE: ",?72,$J(TOTFTEE,8,2)
- W !!,"End of Report"
- D ^%ZISC
- K ^TMP($J)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRGD0 2451 printed Apr 23, 2025@18:41:54 Page 2
- PRSNRGD0 ;WOIFO/KJS - Nursing LOCATION DETAIL Report ;8/2/2011
- +1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified
- +3 QUIT
- +4 ;
- 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 QUIT
- +8 ;
- MAIN ;call to generate and display report for individual activity
- +1 ;
- +2 NEW %ZIS,POP,IOP
- +3 SET %ZIS="MQ"
- +4 DO ^%ZIS
- +5 if POP
- QUIT
- +6 IF $DATA(IO("Q"))
- Begin DoDot:1
- +7 KILL IO("Q")
- +8 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
- +9 SET ZTDESC="Nursing Location Detail Report"
- +10 SET ZTRTN="REPORT^PRSNRGD0"
- +11 SET ZTSAVE("GROUP(")=""
- +12 SET ZTSAVE("TYPE")=""
- +13 DO ^%ZTLOAD
- +14 IF $DATA(ZTSK)
- SET ZTREQ="@"
- WRITE !,"Request "_ZTSK_" Queued."
- End DoDot:1
- +15 IF '$TEST
- DO REPORT
- +16 ;
- +17 QUIT
- +18 ;
- REPORT ;for group of location or t&l
- +1 ;
- +2 NEW PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG,FTEE,TOTNUR,TOTFTEE
- +3 USE IO
- +4 SET SORT=$PIECE(GROUP(0),U,2)
- SET PG=0
- SET (FTEE,TOTFTEE,TOTNUR)=0
- +5 KILL ^TMP($JOB)
- +6 DO HDR^PRSNRGD1
- +7 SET (PICK,STOP)=0
- +8 FOR
- SET PICK=$ORDER(GROUP(PICK))
- if PICK=""!STOP
- QUIT
- Begin DoDot:1
- +9 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
- +10 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))))
- +11 ;
- +12 ;
- +13 KILL ^TMP($JOB)
- +14 SET PRSNGA=""
- +15 FOR
- SET PRSNGA=$ORDER(@PRSNGLB@(PRSNGA))
- if PRSNGA=""!STOP
- QUIT
- Begin DoDot:2
- +16 SET PRSNGB=0
- +17 FOR
- SET PRSNGB=$ORDER(@PRSNGLB@(PRSNGA,PRSNGB))
- if 'PRSNGB!STOP
- QUIT
- Begin DoDot:3
- +18 IF $PIECE(PRSNG,U,2)="N"
- IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB)
- QUIT
- +19 SET PRSIEN=$SELECT($PIECE(PRSNG,U,2)="N":+$GET(^VA(200,PRSNGB,450)),1:PRSNGB)
- +20 SET NURSE=$$ISNURSE^PRSNUT01(PRSIEN)
- +21 if '+NURSE
- QUIT
- +22 ;Job codes
- SET JOB=$$GETCODES^PRSNUT01(PRSIEN)
- +23 SET BOC=$PIECE(JOB,U)
- +24 SET OCC=$PIECE(JOB,U,2)
- +25 DO INFO^PRSNRAS1
- +26 SET ^TMP($JOB,OCC,PRSNAME,PRSIEN)=NURSE
- End DoDot:3
- End DoDot:2
- +27 ; display and underline group sub header
- +28 ;
- +29 if STOP
- QUIT
- +30 SET GHD=$SELECT($PIECE(PRSNG,U,2)="N":"LOCATION",1:"T&L UNIT")_": "_$PIECE(PRSNG,U,3)
- +31 SET TAB=IOM-$LENGTH(GHD)/2-5
- +32 WRITE !!,?TAB,GHD,!
- +33 WRITE ?TAB
- FOR I=1:1:$LENGTH(GHD)
- WRITE "-"
- +34 SET S1=""
- +35 FOR
- SET S1=$ORDER(^TMP($JOB,S1))
- if S1=""!STOP
- QUIT
- Begin DoDot:2
- +36 SET S2=""
- +37 FOR
- SET S2=$ORDER(^TMP($JOB,S1,S2))
- if S2=""!STOP
- QUIT
- Begin DoDot:3
- +38 SET PRSIEN=""
- +39 FOR
- SET PRSIEN=$ORDER(^TMP($JOB,S1,S2,PRSIEN))
- if PRSIEN=""!STOP
- QUIT
- Begin DoDot:4
- +40 SET NURSE=^TMP($JOB,S1,S2,PRSIEN)
- +41 DO DSPLY^PRSNRGD1(PRSIEN,NURSE,.STOP)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +42 WRITE !!,?40,"Total Nurses: ",$JUSTIFY(TOTNUR,4),?60,"Total FTEE: ",?72,$JUSTIFY(TOTFTEE,8,2)
- +43 WRITE !!,"End of Report"
- +44 DO ^%ZISC
- +45 KILL ^TMP($JOB)
- +46 QUIT
- +47 ;
