NURAR110 ;HIRMFO/MD-PRINT MODULE FOR FTEE COMPARISON BY LOCATION ;5/19/97
;;4.0;NURSING SERVICE;**2,33**;Apr 25, 1997
EN1 ;ENTRY POINT TO PRINT MODULE
S NODET=0
S NURFAC="" F S NURFAC=$O(^TMP("NURA",$J,NURFAC)) Q:NURFAC=""!(NURQUIT) S NURSW1(1)=$S(NURMDSW:0,1:1) D:NURMDSW WRITHDR D NEXT Q:NURQUIT
I $O(^TMP("NURA",$J,""))="" D
. I $D(NURSNLOC) S NURX=$O(NURSNLOC("")),NPWARD=$O(NURSNLOC(NURX,"")) D EN6^NURSAUTL S NL1=NPWARD S:$O(NURSNLOC(NURX))="" NURSW1(1)=1 I $G(NURPROG(1))'="" S NURPROG=NURPROG(1),NURSW1=1
. I $G(NURMDSW),$G(NURFAC(1))'="" S NURFAC=NURFAC(1)
. S NODET=1 D:NURMDSW WRITHDR Q:NURQUIT W !,?15,"THERE IS NO DATA FOR THIS REPORT"
. S:$G(NUROUT) NURQUIT=+$G(NUROUT) Q:NURQUIT
. Q
W:'NURQUIT !!!,?25,"*** REPORT FINISHED ***"
Q
NEXT S NURPROG="" F S NURPROG=$O(^TMP("NURA",$J,NURFAC,NURPROG)) Q:NURPROG=""!(NURQUIT) S:'(NURSW1(1)) Z=$$PROD^NURSUT2(NURPROG),Y=$$CNTR^NURSUT2(Z) W:'(NURSW1(1)) !,?Y,$G(Z),!,?Y,$$REPEAT^XLFSTR("-",$L(Z)+1) D Q:NURQUIT
. S NL1="" F S NL1=$O(^TMP("NURA",$J,NURFAC,NURPROG,NL1)) Q:NL1=""!(NURQUIT) D
. . I $D(^TMP("NURA",$J,NURFAC,NURPROG,NL1))'=11 D NODETL S NODET=1 Q
. . S NPRI="" W:NURMDSW&'(NURSW1(1))&'(NODET) !!,?15,"WARD: ",NL1 D:$G(NURSW1(1)) WRITHDR Q:NURQUIT S NURSW1(1)=1 F S NPRI=$O(^TMP("NURA",$J,NURFAC,NURPROG,NL1,NPRI)) Q:NPRI=""!NURQUIT D PRTDETL
. . D:'NURQUIT PRTSUM
Q
WRITHDR ;
I 'NODET I 'NURQUEUE,NURSW1,$E(IOST)="C" W ! D ENDPG^NURSUT1 S:NUROUT NURQUIT=+NUROUT Q:NURQUIT
S NURPAGE=NURPAGE+1 W:$E(IOST)="C"!(NURPAGE>1) @IOF
I $G(NURMDSW),$G(NURFAC)'="" W !,?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
W !,"NURSING SERVICE BUDGETED/ACTUAL FTEE BY WARD",?70,"PAGE: ",NURPAGE
W !!,?31,"BUDGETED",?44,"ACTUAL",!,"TITLE",?33,"FTEE ",?45,"FTEE",?54,"VARIANCE" S Y=DT D:+Y D^DIQ W " ",Y,!,$$REPEAT^XLFSTR("-",80)
I 'NURMDSW S NURSW1=1
I $G(NURSW1),$G(NURSW1(1)),$G(NURPLSW) N Z S Z=$$PROD^NURSUT2(NURPROG),Y=$$CNTR^NURSUT2(Z) W !?Y,$G(Z),!?Y,$$REPEAT^XLFSTR("-",$L(Z)+1)
S:NODET NODET=0
I $G(NURSW1(1)),'NODET W !!,?15,"WARD: ",NL1,!
S NURSW1=1
Q
PRTDETL ;
S NDATA=$G(^TMP("NURA",$J,NURFAC,NURPROG,NL1,NPRI))
S NPO=$P(NDATA,";"),NPOS=$P($P(NDATA,"^"),";",2),NAFTE=$P(NDATA,"^",3),NBFTE=$P(NDATA,"^",2),NVAR=NAFTE-NBFTE
S NURCAT=$O(^NURSF(211.3,"C",$E(NPOS,1,30),"")),NURCAT=$S(NURCAT="":"",'$D(^NURSF(211.3,NURCAT,0)):"",1:$P(^(0),"^",5))
I 'NURMDSW,'NURSW1 D WRITHDR
I $Y>(IOSL-6) D WRITHDR Q:NURQUIT
W !!,NPOS,?30,$J(+NBFTE,8,3),?41,$J(NAFTE,8,3),?52,$J(NVAR,8,3)
S:NURCAT="R" NTRA=NTRA+NAFTE S:NURCAT="L" NTLA=NTLA+NAFTE S:NURCAT="N" NTNB=NTNB+NBFTE,NTNA=NTNA+NAFTE
S:NURCAT="C" NTCA=NTCA+NAFTE S:NURCAT="A" NTAA=NTAA+NAFTE S:NURCAT="O" NTOB=NTOB+NBFTE,NTOA=NTOA+NAFTE
S NTOTB=NTOTB+NBFTE,NTOTA=NTOTA+NAFTE,NAFTE=0
Q
NODETL ;
S (NTOTB,NTOTA,NAFTE,NTRA,NTLA,NTNA,NTCA,NTAA,NTOA)=0
D WRITHDR Q:NURQUIT W !,?15,"THERE IS NO DATA FOR WARD: ",NL1 S NODET=1
D ENDPG^NURSUT1 S:$G(NUROUT) NURQUIT=+$G(NUROUT) Q:NURQUIT
Q
PRTSUM ;
S NL1(0)=1
NEXTP G:$P(^TMP("NURA",$J,NURFAC,NURPROG,NL1),"^",NL1(0))="" NEXTL S NTOOT($P(^(NL1),"^",NL1(0)))=$P(^(NL1),"^",NL1(0)+1),NL1(0)=NL1(0)+2 G NEXTP
NEXTL S:$D(NTOOT("R")) NTRB=NTOOT("R") S:$D(NTOOT("L")) NTLB=NTOOT("L") S:$D(NTOOT("N")) NTNB=NTOOT("N") S:$D(NTOOT("C")) NTCB=NTOOT("C") S:$D(NTOOT("A")) NTAB=NTOOT("A") S:$D(NTOOT("O")) NTOB=NTOOT("O")
S NTOTV=NTOTA-NTOTB,NTRV=NTRA-NTRB,NTLV=NTLA-NTLB,NTNV=NTNA-NTNB,NTCV=NTCA-NTCB,NTAV=NTAA-NTAB,NTOV=NTOA-NTOB
W !,?31,"--------",?42,"--------",?53,"--------"
D:$Y>(IOSL-6) WRITHDR Q:NURQUIT W !,?17,"WARD TOTAL =",?30,$J(+NTOTB,8,3),?41,$J(NTOTA,8,3),?52,$J(NTOTV,8,3)
D:$Y>(IOSL-6) WRITHDR Q:NURQUIT W !!!,?19,"RN TOTAL =" I +NTRB'=0!(+NTRA'=0)!(+NTRV'=0) W ?30,$J(+NTRB,8,3),?41,$J(NTRA,8,3),?52,$J(NTRV,8,3)
D:$Y>(IOSL-6) WRITHDR Q:NURQUIT W !,?18,"LPN TOTAL =" I +NTLB'=0!(+NTLA'=0)!(+NTLV'=0) W ?30,$J(+NTLB,8,3),?41,$J(NTLA,8,3),?52,$J(NTLV,8,3)
D:$Y>(IOSL-6) WRITHDR Q:NURQUIT W !,?19,"NA TOTAL = " I +NTNB'=0!(+NTNA'=0)!(+NTNV'=0) W ?30,$J(+NTNB,8,3),?41,$J(NTNA,8,3),?52,$J(NTNV,8,3)
D:$Y>(IOSL-6) WRITHDR Q:NURQUIT W !,?16,"ADMIN TOTAL = " I +NTAB'=0!(+NTAA'=0)!(+NTAV'=0) W ?30,$J(+NTAB,8,3),?41,$J(NTAA,8,3),?52,$J(NTAV,8,3)
D:$Y>(IOSL-6) WRITHDR Q:NURQUIT W !,?13,"CLERICAL TOTAL =" I +NTCB'=0!(+NTCA'=0)!(+NTCV'=0) W ?30,$J(+NTCB,8,3),?41,$J(NTCA,8,3),?52,$J(NTCV,8,3)
D:$Y>(IOSL-6) WRITHDR Q:NURQUIT W !,?16,"OTHER TOTAL =" I +NTOB'=0!(+NTOA'=0)!(+NTOV'=0) W ?30,$J(+NTOB,8,3),?41,$J(NTOA,8,3),?52,$J(NTOV,8,3)
S NTNAT=NTNAT+NTNA,NTRAT=NTRAT+NTRA,NTLAT=NTLAT+NTLA,NTCAT=NTCAT+NTCA,NTAAT=NTAAT+NTAA,NTOAT=NTOAT+NTOA
S (NTOTA,NTOTB,NTRA,NTLA,NTNA,NTCA,NTAA,NTOA,NTRB,NTLB,NTNB,NTCB,NTAB,NTOB)=0,X="" F Y=0:0 S X=$O(NTOOT(X)) Q:X="" S NTOOT(X)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAR110 4765 printed Jan 18, 2025@03:20:49 Page 2
NURAR110 ;HIRMFO/MD-PRINT MODULE FOR FTEE COMPARISON BY LOCATION ;5/19/97
+1 ;;4.0;NURSING SERVICE;**2,33**;Apr 25, 1997
EN1 ;ENTRY POINT TO PRINT MODULE
+1 SET NODET=0
+2 SET NURFAC=""
FOR
SET NURFAC=$ORDER(^TMP("NURA",$JOB,NURFAC))
if NURFAC=""!(NURQUIT)
QUIT
SET NURSW1(1)=$SELECT(NURMDSW:0,1:1)
if NURMDSW
DO WRITHDR
DO NEXT
if NURQUIT
QUIT
+3 IF $ORDER(^TMP("NURA",$JOB,""))=""
Begin DoDot:1
+4 IF $DATA(NURSNLOC)
SET NURX=$ORDER(NURSNLOC(""))
SET NPWARD=$ORDER(NURSNLOC(NURX,""))
DO EN6^NURSAUTL
SET NL1=NPWARD
if $ORDER(NURSNLOC(NURX))=""
SET NURSW1(1)=1
IF $GET(NURPROG(1))'=""
SET NURPROG=NURPROG(1)
SET NURSW1=1
+5 IF $GET(NURMDSW)
IF $GET(NURFAC(1))'=""
SET NURFAC=NURFAC(1)
+6 SET NODET=1
if NURMDSW
DO WRITHDR
if NURQUIT
QUIT
WRITE !,?15,"THERE IS NO DATA FOR THIS REPORT"
+7 if $GET(NUROUT)
SET NURQUIT=+$GET(NUROUT)
if NURQUIT
QUIT
+8 QUIT
End DoDot:1
+9 if 'NURQUIT
WRITE !!!,?25,"*** REPORT FINISHED ***"
+10 QUIT
NEXT SET NURPROG=""
FOR
SET NURPROG=$ORDER(^TMP("NURA",$JOB,NURFAC,NURPROG))
if NURPROG=""!(NURQUIT)
QUIT
if '(NURSW1(1))
SET Z=$$PROD^NURSUT2(NURPROG)
SET Y=$$CNTR^NURSUT2(Z)
if '(NURSW1(1))
WRITE !,?Y,$GET(Z),!,?Y,$$REPEAT^XLFSTR("-",$LENGTH(Z)+1)
Begin DoDot:1
+1 SET NL1=""
FOR
SET NL1=$ORDER(^TMP("NURA",$JOB,NURFAC,NURPROG,NL1))
if NL1=""!(NURQUIT)
QUIT
Begin DoDot:2
+2 IF $DATA(^TMP("NURA",$JOB,NURFAC,NURPROG,NL1))'=11
DO NODETL
SET NODET=1
QUIT
+3 SET NPRI=""
if NURMDSW&'(NURSW1(1))&'(NODET)
WRITE !!,?15,"WARD: ",NL1
if $GET(NURSW1(1))
DO WRITHDR
if NURQUIT
QUIT
SET NURSW1(1)=1
FOR
SET NPRI=$ORDER(^TMP("NURA",$JOB,NURFAC,NURPROG,NL1,NPRI))
if NPRI=""!NURQUIT
QUIT
DO PRTDETL
+4 if 'NURQUIT
DO PRTSUM
End DoDot:2
End DoDot:1
if NURQUIT
QUIT
+5 QUIT
WRITHDR ;
+1 IF 'NODET
IF 'NURQUEUE
IF NURSW1
IF $EXTRACT(IOST)="C"
WRITE !
DO ENDPG^NURSUT1
if NUROUT
SET NURQUIT=+NUROUT
if NURQUIT
QUIT
+2 SET NURPAGE=NURPAGE+1
if $EXTRACT(IOST)="C"!(NURPAGE>1)
WRITE @IOF
+3 IF $GET(NURMDSW)
IF $GET(NURFAC)'=""
WRITE !,?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
+4 WRITE !,"NURSING SERVICE BUDGETED/ACTUAL FTEE BY WARD",?70,"PAGE: ",NURPAGE
+5 WRITE !!,?31,"BUDGETED",?44,"ACTUAL",!,"TITLE",?33,"FTEE ",?45,"FTEE",?54,"VARIANCE"
SET Y=DT
if +Y
DO D^DIQ
WRITE " ",Y,!,$$REPEAT^XLFSTR("-",80)
+6 IF 'NURMDSW
SET NURSW1=1
+7 IF $GET(NURSW1)
IF $GET(NURSW1(1))
IF $GET(NURPLSW)
NEW Z
SET Z=$$PROD^NURSUT2(NURPROG)
SET Y=$$CNTR^NURSUT2(Z)
WRITE !?Y,$GET(Z),!?Y,$$REPEAT^XLFSTR("-",$LENGTH(Z)+1)
+8 if NODET
SET NODET=0
+9 IF $GET(NURSW1(1))
IF 'NODET
WRITE !!,?15,"WARD: ",NL1,!
+10 SET NURSW1=1
+11 QUIT
PRTDETL ;
+1 SET NDATA=$GET(^TMP("NURA",$JOB,NURFAC,NURPROG,NL1,NPRI))
+2 SET NPO=$PIECE(NDATA,";")
SET NPOS=$PIECE($PIECE(NDATA,"^"),";",2)
SET NAFTE=$PIECE(NDATA,"^",3)
SET NBFTE=$PIECE(NDATA,"^",2)
SET NVAR=NAFTE-NBFTE
+3 SET NURCAT=$ORDER(^NURSF(211.3,"C",$EXTRACT(NPOS,1,30),""))
SET NURCAT=$SELECT(NURCAT="":"",'$DATA(^NURSF(211.3,NURCAT,0)):"",1:$PIECE(^(0),"^",5))
+4 IF 'NURMDSW
IF 'NURSW1
DO WRITHDR
+5 IF $Y>(IOSL-6)
DO WRITHDR
if NURQUIT
QUIT
+6 WRITE !!,NPOS,?30,$JUSTIFY(+NBFTE,8,3),?41,$JUSTIFY(NAFTE,8,3),?52,$JUSTIFY(NVAR,8,3)
+7 if NURCAT="R"
SET NTRA=NTRA+NAFTE
if NURCAT="L"
SET NTLA=NTLA+NAFTE
if NURCAT="N"
SET NTNB=NTNB+NBFTE
SET NTNA=NTNA+NAFTE
+8 if NURCAT="C"
SET NTCA=NTCA+NAFTE
if NURCAT="A"
SET NTAA=NTAA+NAFTE
if NURCAT="O"
SET NTOB=NTOB+NBFTE
SET NTOA=NTOA+NAFTE
+9 SET NTOTB=NTOTB+NBFTE
SET NTOTA=NTOTA+NAFTE
SET NAFTE=0
+10 QUIT
NODETL ;
+1 SET (NTOTB,NTOTA,NAFTE,NTRA,NTLA,NTNA,NTCA,NTAA,NTOA)=0
+2 DO WRITHDR
if NURQUIT
QUIT
WRITE !,?15,"THERE IS NO DATA FOR WARD: ",NL1
SET NODET=1
+3 DO ENDPG^NURSUT1
if $GET(NUROUT)
SET NURQUIT=+$GET(NUROUT)
if NURQUIT
QUIT
+4 QUIT
PRTSUM ;
+1 SET NL1(0)=1
NEXTP if $PIECE(^TMP("NURA",$JOB,NURFAC,NURPROG,NL1),"^",NL1(0))=""
GOTO NEXTL
SET NTOOT($PIECE(^(NL1),"^",NL1(0)))=$PIECE(^(NL1),"^",NL1(0)+1)
SET NL1(0)=NL1(0)+2
GOTO NEXTP
NEXTL if $DATA(NTOOT("R"))
SET NTRB=NTOOT("R")
if $DATA(NTOOT("L"))
SET NTLB=NTOOT("L")
if $DATA(NTOOT("N"))
SET NTNB=NTOOT("N")
if $DATA(NTOOT("C"))
SET NTCB=NTOOT("C")
if $DATA(NTOOT("A"))
SET NTAB=NTOOT("A")
if $DATA(NTOOT("O"))
SET NTOB=NTOOT("O")
+1 SET NTOTV=NTOTA-NTOTB
SET NTRV=NTRA-NTRB
SET NTLV=NTLA-NTLB
SET NTNV=NTNA-NTNB
SET NTCV=NTCA-NTCB
SET NTAV=NTAA-NTAB
SET NTOV=NTOA-NTOB
+2 WRITE !,?31,"--------",?42,"--------",?53,"--------"
+3 if $Y>(IOSL-6)
DO WRITHDR
if NURQUIT
QUIT
WRITE !,?17,"WARD TOTAL =",?30,$JUSTIFY(+NTOTB,8,3),?41,$JUSTIFY(NTOTA,8,3),?52,$JUSTIFY(NTOTV,8,3)
+4 if $Y>(IOSL-6)
DO WRITHDR
if NURQUIT
QUIT
WRITE !!!,?19,"RN TOTAL ="
IF +NTRB'=0!(+NTRA'=0)!(+NTRV'=0)
WRITE ?30,$JUSTIFY(+NTRB,8,3),?41,$JUSTIFY(NTRA,8,3),?52,$JUSTIFY(NTRV,8,3)
+5 if $Y>(IOSL-6)
DO WRITHDR
if NURQUIT
QUIT
WRITE !,?18,"LPN TOTAL ="
IF +NTLB'=0!(+NTLA'=0)!(+NTLV'=0)
WRITE ?30,$JUSTIFY(+NTLB,8,3),?41,$JUSTIFY(NTLA,8,3),?52,$JUSTIFY(NTLV,8,3)
+6 if $Y>(IOSL-6)
DO WRITHDR
if NURQUIT
QUIT
WRITE !,?19,"NA TOTAL = "
IF +NTNB'=0!(+NTNA'=0)!(+NTNV'=0)
WRITE ?30,$JUSTIFY(+NTNB,8,3),?41,$JUSTIFY(NTNA,8,3),?52,$JUSTIFY(NTNV,8,3)
+7 if $Y>(IOSL-6)
DO WRITHDR
if NURQUIT
QUIT
WRITE !,?16,"ADMIN TOTAL = "
IF +NTAB'=0!(+NTAA'=0)!(+NTAV'=0)
WRITE ?30,$JUSTIFY(+NTAB,8,3),?41,$JUSTIFY(NTAA,8,3),?52,$JUSTIFY(NTAV,8,3)
+8 if $Y>(IOSL-6)
DO WRITHDR
if NURQUIT
QUIT
WRITE !,?13,"CLERICAL TOTAL ="
IF +NTCB'=0!(+NTCA'=0)!(+NTCV'=0)
WRITE ?30,$JUSTIFY(+NTCB,8,3),?41,$JUSTIFY(NTCA,8,3),?52,$JUSTIFY(NTCV,8,3)
+9 if $Y>(IOSL-6)
DO WRITHDR
if NURQUIT
QUIT
WRITE !,?16,"OTHER TOTAL ="
IF +NTOB'=0!(+NTOA'=0)!(+NTOV'=0)
WRITE ?30,$JUSTIFY(+NTOB,8,3),?41,$JUSTIFY(NTOA,8,3),?52,$JUSTIFY(NTOV,8,3)
+10 SET NTNAT=NTNAT+NTNA
SET NTRAT=NTRAT+NTRA
SET NTLAT=NTLAT+NTLA
SET NTCAT=NTCAT+NTCA
SET NTAAT=NTAAT+NTAA
SET NTOAT=NTOAT+NTOA
+11 SET (NTOTA,NTOTB,NTRA,NTLA,NTNA,NTCA,NTAA,NTOA,NTRB,NTLB,NTNB,NTCB,NTAB,NTOB)=0
SET X=""
FOR Y=0:0
SET X=$ORDER(NTOOT(X))
if X=""
QUIT
SET NTOOT(X)=""
+12 QUIT
