NURA5C ;HIRMFO/MD,FT-SALARY REPORT BY LOCATION AND SVC. CATEGORY
;;4.0;NURSING SERVICE;**21**;Apr 25, 1997
S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
W !
S (NURQUEUE,NURSW1,NURPAGE,NUROUT)=0
D EN1^NURSAUTL G QUIT:NUROUT
I NURMDSW S DIC(0)="AEQZ",NURPLSCR=1 D EN5^NURSAGSP G:$G(NUROUT) QUIT
I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
W ! D EN1^NURSAGSP G:$G(NUROUT) QUIT
D EN3^NURSAGSP G:$G(NUROUT) QUIT
W ! S ZTDESC="Salary Report by location and service category",ZTRTN="START^NURA5C" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
START ;
K ^TMP($J) S (CAVG,NAVG,FAVG,LAVG,PAVG,NSALT,PSALT,FSALT,CSALT,LSALT,CSUBC,NSUBC,PSUBC,FSUBC,LSUBC)=0
S X="" F I=0:0 S X=$O(^NURSF(210,"AC",X)) Q:X="" I X'="R" F DA=0:0 S DA=$O(^NURSF(210,"AC",X,DA)) Q:DA'>0 I $D(^NURSF(210,DA,0)),+$P(^(0),U) S DA(1)=$P(^(0),U) D BLD1
I '$D(^TMP($J)) S NURPROG(2)=$S($G(NURPROG(1))'="":NURPROG(1),1:"") D HEADER W !,"THERE IS NO DATA FOR THIS REPORT" G QUIT
U IO D PRINT
S:NUROUT NSALT=NSALT+CSALT D:'NUROUT PGCHK Q:NUROUT
S:+NSALT>0 NAVG=NSALT/NSUBC S X="",$P(X,"*",13)="" W !!?22,X,!,"EMPLOYEES COUNTED",?25,$J(NSUBC,9,2),!,"REPORT TOTAL ",?22,$J(NSALT,12,2),!,"AVERAGE SALARY ",?22,$J(NAVG,12,2)
QUIT K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
Q
BLD1 F NURNODE4=0:0 S NURNODE4=$O(^NURSF(211.8,"C",DA(1),NURNODE4)) Q:NURNODE4'>0 F NURNODE5=0:0 S NURNODE5=$O(^NURSF(211.8,"C",DA(1),NURNODE4,NURNODE5)) Q:NURNODE5'>0 D
.I $D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),$P(^(0),U)'>DT&(('$P(^(0),U,6))!($P(^(0),U,6)'<DT)) D BLD2
.Q
Q
BLD2 Q:NURSZAP>7&(NURSZDA'=DA) S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP Q:'NURSZORT
S NLOCN=$S($D(^NURSF(211.8,NURNODE4,0)):$P(^(0),U),1:" BLANK")
I +NLOCN S NPWARD=NLOCN D EN7^NURSAUTL S NLOCN(1)=$S(NPWARD'="":$E(NPWARD,1,10),1:" BLANK")
W:$E(IOST)="C"&($R(100)) "." S NURNEN=4 D SETFAC^NURAAGS1,SETPROG^NURAAGS1,SETCAT^NURAAGS1
I $G(NURMDSW),$G(NURFAC)=0,$G(NURFAC(1))'=$G(NURFAC(2)) Q
I $G(NURHOSP)=0,'$D(NURSNLOC(NLOCN(1))) Q
I $G(NURPLSW),$G(NURPROG)=0,$G(NURPROG(1))'=$G(NURPROG(2)) Q
I $E($G(NURSCATY))="O",$P($G(NURSCATY),"O ",2)="" S NURSCATY="O"
I $S($E(NURSCATY)'="O":'$D(^TMP("NURSCAT",$J,NURSCATY)),$P($G(NURSCATY),"O ",2)'="":'$D(^TMP("NURSCAT",$J,$E(NURSCATY,3,99))),$P($G(NURSCATY),"O ",2)="":'$D(^TMP("NURSCAT",$J,"O")),1:0) Q
I $D(^VA(200,DA(1),0)),$P(^(0),U,1)'="" S N1=$P(^(0),U)
E S N1=" BLANK"
I $G(NURMDSW),$G(NURFAC)=0,$G(NURFAC(1))'=$G(NURFAC(2)) Q
S ^TMP($J,NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,N1,DA)=+$P($G(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),U,4)
Q
; DETAIL LINE PRINT ROUTINE
PRINT S NURFAC(2)="" F S NURFAC(2)=$O(^TMP($J,NURFAC(2))) Q:NURFAC(2)=""!(NUROUT) D P0 Q:NUROUT D:NURMDSW FSUB Q:NUROUT
Q
P0 S NURPROG(2)="" F S NURPROG(2)=$O(^TMP($J,NURFAC(2),NURPROG(2))) Q:NURPROG(2)=""!(NUROUT) D P1 Q:NUROUT I NURPLSW D PSUB Q:NUROUT
Q
P1 S NLOC="" F S NLOC=$O(^TMP($J,NURFAC(2),NURPROG(2),NLOC)) Q:NLOC=""!NUROUT D HEADER Q:NUROUT D P2 Q:NUROUT D LSUB Q:NUROUT
Q
P2 S NURCAT="" F S NURCAT=$O(^TMP($J,NURFAC(2),NURPROG(2),NLOC,NURCAT)) Q:NURCAT=""!(NUROUT) D P3 Q:NUROUT D CSUB Q:NUROUT W !
Q
P3 S N1="" F S N1=$O(^TMP($J,NURFAC(2),NURPROG(2),NLOC,NURCAT,N1)) Q:N1=""!(NUROUT) S DA=0 F S DA=$O(^TMP($J,NURFAC(2),NURPROG(2),NLOC,NURCAT,N1,DA)) Q:DA'>0 S NFTEE=+^(DA) D WRITE Q:NUROUT
Q
WRITE D PGCHK Q:NUROUT
S NURSAL=(+$$EN12^NURSUT0(DA)*NFTEE)
I $P($G(^VA(200,$P(^NURSF(210,DA,0),U),0)),U)'="" W !,$S(+NURSAL'>0:"** ",1:" "),$E($P(^(0),U),1,20)
E Q
W:NURCAT'=" BLANK" ?28,$$CAT^NURSUT2(NURCAT) W ?42,NLOC
S DATA=$G(^NURSF(210,DA,7))
S DATA(1)=$S($G(^NURSF(211.1,+DATA,0))'="":^(0),1:"")
W:DATA(1)'="" ?56,$P(DATA(1),U) W:+NURSAL>0 ?69,$J(NURSAL,6,2)
I NURSAL>0 S FSALT=FSALT+NURSAL,FSUBC=FSUBC+1,LSALT=LSALT+NURSAL,LSUBC=LSUBC+1,CSALT=CSALT+NURSAL,CSUBC=CSUBC+1,PSALT=PSALT+NURSAL,PSUBC=PSUBC+1,NSALT=NSALT+NURSAL,NSUBC=NSUBC+1
Q
CSUB ; CATEGORY SUBTLS/AVG
D PGCHK Q:NUROUT W !!?20,"-------------"
S:CSALT>0 CAVG=CSALT/CSUBC
W !,"EMPLOYEES COUNTED:",?25,$J(CSUBC,8,2)
W !,"CATEGORY SUBTOTAL:",?22,$J(CSALT,11,2)
W !,"AVERAGE SALARY:",?22,$J(CAVG,11,2)
S (CSALT,CSUBC,CAVG)=0
Q
PSUB ; PRODUCT LINE SUBTLS/AVG
D PGCHK Q:NUROUT W !?20,"-------------"
S:PSALT>0 PAVG=PSALT/PSUBC
W !,"EMPLOYEES COUNTED:",?25,$J(PSUBC,8,2)
W !,"PRODUCT LINE SUBTOTAL:",?22,$J(PSALT,11,2)
W !,"AVERAGE SALARY:",?22,$J(PAVG,11,2)
S (PAVG,PSALT,PSUBC)=0
Q
FSUB ; FACILITY SUBTLS/AVG
D PGCHK Q:NUROUT W !?22,"------------"
S:FSALT>0 FAVG=FSALT/FSUBC
W !,"EMPLOYEES COUNTED:",?25,$J(FSUBC,9,2)
W !,"FACILITY SUBTOTAL:",?22,$J(FSALT,12,2)
W !,"AVERAGE SALARY:",?22,$J(FAVG,12,2)
S (FAVG,FSALT,FSUBC)=0
Q
LSUB ;LOCATION SUBTLS/AVG
D PGCHK Q:NUROUT W !?20,"-------------"
S:LSALT>0 LAVG=LSALT/LSUBC
W !,"EMPLOYEES COUNTED:",?25,$J(LSUBC,8,2)
W !,"UNIT SUBTOTAL:",?22,$J(LSALT,11,2)
W !,"AVERAGE SALARY:",?22,$J(LAVG,11,2)
S (LAVG,LSALT,LSUBC)=0
Q
PGCHK ; FORM FEED CHECK
I ($Y>(IOSL-6)) D HEADER
Q
S NURPAGE=NURPAGE+1,NURSW1=1 W:$E(IOST)="C"!(NURPAGE>1) @IOF
I NURMDSW,$G(NURFAC(2))'="" W ?$$CNTR^NURSUT2(NURFAC(2)),$$FACL^NURSUT2(NURFAC(2))
W !!,"STAFF SALARIES BY LOCATION AND SERVICE CATEGORY" S X="T" D ^%DT D:+Y D^DIQ W ?54,Y,?69,"PAGE: ",NURPAGE
W !!,?28,"SERVICE",?56,"GRADE/STEP",?69,"GRADE/STEP" W !,"EMPLOYEE NAME",?28,"CATEGORY",?42,"LOCATION",?56,"CODE",?69,"SALARY" W !,$$REPEAT^XLFSTR("-",80)
I $G(NURPLSW),$G(NURPROG(2))'="" N Z S Z=$$PROD^NURSUT2(NURPROG(2)) W !,?$$CNTR^NURSUT2(NURPROG(2)),$G(Z),!,?$$CNTR^NURSUT2(NURPROG(2)),$$REPEAT^XLFSTR("-",$L(Z)+1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURA5C 5704 printed Dec 13, 2024@02:18:09 Page 2
NURA5C ;HIRMFO/MD,FT-SALARY REPORT BY LOCATION AND SVC. CATEGORY
+1 ;;4.0;NURSING SERVICE;**21**;Apr 25, 1997
+2 SET X=$GET(^DIC(213.9,1,"OFF"))
if X=""!(X=1)
QUIT
+3 WRITE !
+4 SET (NURQUEUE,NURSW1,NURPAGE,NUROUT)=0
+5 DO EN1^NURSAUTL
if NUROUT
GOTO QUIT
+6 IF NURMDSW
SET DIC(0)="AEQZ"
SET NURPLSCR=1
DO EN5^NURSAGSP
if $GET(NUROUT)
GOTO QUIT
+7 IF NURMDSW=0
IF NURPLSW=1
SET NURPLSCR=1
DO PRD^NURSAGSP
KILL NURPLSCR
IF $GET(NUROUT)
GOTO QUIT
+8 WRITE !
DO EN1^NURSAGSP
if $GET(NUROUT)
GOTO QUIT
+9 DO EN3^NURSAGSP
if $GET(NUROUT)
GOTO QUIT
+10 WRITE !
SET ZTDESC="Salary Report by location and service category"
SET ZTRTN="START^NURA5C"
DO EN7^NURSUT0
if POP!($DATA(ZTSK))
GOTO QUIT
START ;
+1 KILL ^TMP($JOB)
SET (CAVG,NAVG,FAVG,LAVG,PAVG,NSALT,PSALT,FSALT,CSALT,LSALT,CSUBC,NSUBC,PSUBC,FSUBC,LSUBC)=0
+2 SET X=""
FOR I=0:0
SET X=$ORDER(^NURSF(210,"AC",X))
if X=""
QUIT
IF X'="R"
FOR DA=0:0
SET DA=$ORDER(^NURSF(210,"AC",X,DA))
if DA'>0
QUIT
IF $DATA(^NURSF(210,DA,0))
IF +$PIECE(^(0),U)
SET DA(1)=$PIECE(^(0),U)
DO BLD1
+3 IF '$DATA(^TMP($JOB))
SET NURPROG(2)=$SELECT($GET(NURPROG(1))'="":NURPROG(1),1:"")
DO HEADER
WRITE !,"THERE IS NO DATA FOR THIS REPORT"
GOTO QUIT
+4 USE IO
DO PRINT
+5 if NUROUT
SET NSALT=NSALT+CSALT
if 'NUROUT
DO PGCHK
if NUROUT
QUIT
+6 if +NSALT>0
SET NAVG=NSALT/NSUBC
SET X=""
SET $PIECE(X,"*",13)=""
WRITE !!?22,X,!,"EMPLOYEES COUNTED",?25,$JUSTIFY(NSUBC,9,2),!,"REPORT TOTAL ",?22,$JUSTIFY(NSALT,12,2),!,"AVERAGE SALARY ",?22,$JUSTIFY(NAVG,12,2)
QUIT KILL ^TMP($JOB)
DO CLOSE^NURSUT1
DO ^NURAKILL
+1 QUIT
BLD1 FOR NURNODE4=0:0
SET NURNODE4=$ORDER(^NURSF(211.8,"C",DA(1),NURNODE4))
if NURNODE4'>0
QUIT
FOR NURNODE5=0:0
SET NURNODE5=$ORDER(^NURSF(211.8,"C",DA(1),NURNODE4,NURNODE5))
if NURNODE5'>0
QUIT
Begin DoDot:1
+1 IF $DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0))
IF $PIECE(^(0),U)'>DT&(('$PIECE(^(0),U,6))!($PIECE(^(0),U,6)'<DT))
DO BLD2
+2 QUIT
End DoDot:1
+3 QUIT
BLD2 if NURSZAP>7&(NURSZDA'=DA)
QUIT
SET NURSZORT=1
if NURSZAP>6
DO EN3^NURSAUTL
if NURSZORT&NURSZAP
DO EN2^NURSAUTL
if 'NURSZORT
QUIT
+1 SET NLOCN=$SELECT($DATA(^NURSF(211.8,NURNODE4,0)):$PIECE(^(0),U),1:" BLANK")
+2 IF +NLOCN
SET NPWARD=NLOCN
DO EN7^NURSAUTL
SET NLOCN(1)=$SELECT(NPWARD'="":$EXTRACT(NPWARD,1,10),1:" BLANK")
+3 if $EXTRACT(IOST)="C"&($RANDOM(100))
WRITE "."
SET NURNEN=4
DO SETFAC^NURAAGS1
DO SETPROG^NURAAGS1
DO SETCAT^NURAAGS1
+4 IF $GET(NURMDSW)
IF $GET(NURFAC)=0
IF $GET(NURFAC(1))'=$GET(NURFAC(2))
QUIT
+5 IF $GET(NURHOSP)=0
IF '$DATA(NURSNLOC(NLOCN(1)))
QUIT
+6 IF $GET(NURPLSW)
IF $GET(NURPROG)=0
IF $GET(NURPROG(1))'=$GET(NURPROG(2))
QUIT
+7 IF $EXTRACT($GET(NURSCATY))="O"
IF $PIECE($GET(NURSCATY),"O ",2)=""
SET NURSCATY="O"
+8 IF $SELECT($EXTRACT(NURSCATY)'="O":'$DATA(^TMP("NURSCAT",$JOB,NURSCATY)),$PIECE($GET(NURSCATY),"O ",2)'="":'$DATA(^TMP("NURSCAT",$JOB,$EXTRACT(NURSCATY,3,99))),$PIECE($GET(NURSCATY),"O ",2)="":'$DATA(^TMP("NURSCAT",$JOB,"O")),1:0)
QUIT
+9 IF $DATA(^VA(200,DA(1),0))
IF $PIECE(^(0),U,1)'=""
SET N1=$PIECE(^(0),U)
+10 IF '$TEST
SET N1=" BLANK"
+11 IF $GET(NURMDSW)
IF $GET(NURFAC)=0
IF $GET(NURFAC(1))'=$GET(NURFAC(2))
QUIT
+12 SET ^TMP($JOB,NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,N1,DA)=+$PIECE($GET(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),U,4)
+13 QUIT
+14 ; DETAIL LINE PRINT ROUTINE
PRINT SET NURFAC(2)=""
FOR
SET NURFAC(2)=$ORDER(^TMP($JOB,NURFAC(2)))
if NURFAC(2)=""!(NUROUT)
QUIT
DO P0
if NUROUT
QUIT
if NURMDSW
DO FSUB
if NUROUT
QUIT
+1 QUIT
P0 SET NURPROG(2)=""
FOR
SET NURPROG(2)=$ORDER(^TMP($JOB,NURFAC(2),NURPROG(2)))
if NURPROG(2)=""!(NUROUT)
QUIT
DO P1
if NUROUT
QUIT
IF NURPLSW
DO PSUB
if NUROUT
QUIT
+1 QUIT
P1 SET NLOC=""
FOR
SET NLOC=$ORDER(^TMP($JOB,NURFAC(2),NURPROG(2),NLOC))
if NLOC=""!NUROUT
QUIT
DO HEADER
if NUROUT
QUIT
DO P2
if NUROUT
QUIT
DO LSUB
if NUROUT
QUIT
+1 QUIT
P2 SET NURCAT=""
FOR
SET NURCAT=$ORDER(^TMP($JOB,NURFAC(2),NURPROG(2),NLOC,NURCAT))
if NURCAT=""!(NUROUT)
QUIT
DO P3
if NUROUT
QUIT
DO CSUB
if NUROUT
QUIT
WRITE !
+1 QUIT
P3 SET N1=""
FOR
SET N1=$ORDER(^TMP($JOB,NURFAC(2),NURPROG(2),NLOC,NURCAT,N1))
if N1=""!(NUROUT)
QUIT
SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,NURFAC(2),NURPROG(2),NLOC,NURCAT,N1,DA))
if DA'>0
QUIT
SET NFTEE=+^(DA)
DO WRITE
if NUROUT
QUIT
+1 QUIT
WRITE DO PGCHK
if NUROUT
QUIT
+1 SET NURSAL=(+$$EN12^NURSUT0(DA)*NFTEE)
+2 IF $PIECE($GET(^VA(200,$PIECE(^NURSF(210,DA,0),U),0)),U)'=""
WRITE !,$SELECT(+NURSAL'>0:"** ",1:" "),$EXTRACT($PIECE(^(0),U),1,20)
+3 IF '$TEST
QUIT
+4 if NURCAT'=" BLANK"
WRITE ?28,$$CAT^NURSUT2(NURCAT)
WRITE ?42,NLOC
+5 SET DATA=$GET(^NURSF(210,DA,7))
+6 SET DATA(1)=$SELECT($GET(^NURSF(211.1,+DATA,0))'="":^(0),1:"")
+7 if DATA(1)'=""
WRITE ?56,$PIECE(DATA(1),U)
if +NURSAL>0
WRITE ?69,$JUSTIFY(NURSAL,6,2)
+8 IF NURSAL>0
SET FSALT=FSALT+NURSAL
SET FSUBC=FSUBC+1
SET LSALT=LSALT+NURSAL
SET LSUBC=LSUBC+1
SET CSALT=CSALT+NURSAL
SET CSUBC=CSUBC+1
SET PSALT=PSALT+NURSAL
SET PSUBC=PSUBC+1
SET NSALT=NSALT+NURSAL
SET NSUBC=NSUBC+1
+9 QUIT
CSUB ; CATEGORY SUBTLS/AVG
+1 DO PGCHK
if NUROUT
QUIT
WRITE !!?20,"-------------"
+2 if CSALT>0
SET CAVG=CSALT/CSUBC
+3 WRITE !,"EMPLOYEES COUNTED:",?25,$JUSTIFY(CSUBC,8,2)
+4 WRITE !,"CATEGORY SUBTOTAL:",?22,$JUSTIFY(CSALT,11,2)
+5 WRITE !,"AVERAGE SALARY:",?22,$JUSTIFY(CAVG,11,2)
+6 SET (CSALT,CSUBC,CAVG)=0
+7 QUIT
PSUB ; PRODUCT LINE SUBTLS/AVG
+1 DO PGCHK
if NUROUT
QUIT
WRITE !?20,"-------------"
+2 if PSALT>0
SET PAVG=PSALT/PSUBC
+3 WRITE !,"EMPLOYEES COUNTED:",?25,$JUSTIFY(PSUBC,8,2)
+4 WRITE !,"PRODUCT LINE SUBTOTAL:",?22,$JUSTIFY(PSALT,11,2)
+5 WRITE !,"AVERAGE SALARY:",?22,$JUSTIFY(PAVG,11,2)
+6 SET (PAVG,PSALT,PSUBC)=0
+7 QUIT
FSUB ; FACILITY SUBTLS/AVG
+1 DO PGCHK
if NUROUT
QUIT
WRITE !?22,"------------"
+2 if FSALT>0
SET FAVG=FSALT/FSUBC
+3 WRITE !,"EMPLOYEES COUNTED:",?25,$JUSTIFY(FSUBC,9,2)
+4 WRITE !,"FACILITY SUBTOTAL:",?22,$JUSTIFY(FSALT,12,2)
+5 WRITE !,"AVERAGE SALARY:",?22,$JUSTIFY(FAVG,12,2)
+6 SET (FAVG,FSALT,FSUBC)=0
+7 QUIT
LSUB ;LOCATION SUBTLS/AVG
+1 DO PGCHK
if NUROUT
QUIT
WRITE !?20,"-------------"
+2 if LSALT>0
SET LAVG=LSALT/LSUBC
+3 WRITE !,"EMPLOYEES COUNTED:",?25,$JUSTIFY(LSUBC,8,2)
+4 WRITE !,"UNIT SUBTOTAL:",?22,$JUSTIFY(LSALT,11,2)
+5 WRITE !,"AVERAGE SALARY:",?22,$JUSTIFY(LAVG,11,2)
+6 SET (LAVG,LSALT,LSUBC)=0
+7 QUIT
PGCHK ; FORM FEED CHECK
+1 IF ($Y>(IOSL-6))
DO HEADER
+2 QUIT
IF $EXTRACT(IOST)="C"
IF NURSW1
DO ENDPG^NURSUT1
if NUROUT
QUIT
+1 SET NURPAGE=NURPAGE+1
SET NURSW1=1
if $EXTRACT(IOST)="C"!(NURPAGE>1)
WRITE @IOF
+2 IF NURMDSW
IF $GET(NURFAC(2))'=""
WRITE ?$$CNTR^NURSUT2(NURFAC(2)),$$FACL^NURSUT2(NURFAC(2))
+3 WRITE !!,"STAFF SALARIES BY LOCATION AND SERVICE CATEGORY"
SET X="T"
DO ^%DT
if +Y
DO D^DIQ
WRITE ?54,Y,?69,"PAGE: ",NURPAGE
+4 WRITE !!,?28,"SERVICE",?56,"GRADE/STEP",?69,"GRADE/STEP"
WRITE !,"EMPLOYEE NAME",?28,"CATEGORY",?42,"LOCATION",?56,"CODE",?69,"SALARY"
WRITE !,$$REPEAT^XLFSTR("-",80)
+5 IF $GET(NURPLSW)
IF $GET(NURPROG(2))'=""
NEW Z
SET Z=$$PROD^NURSUT2(NURPROG(2))
WRITE !,?$$CNTR^NURSUT2(NURPROG(2)),$GET(Z),!,?$$CNTR^NURSUT2(NURPROG(2)),$$REPEAT^XLFSTR("-",$LENGTH(Z)+1)
+6 QUIT
