- NURARWL2 ;HIRMFO/MD-(CURRENT) MANHOURS WORKLOAD STAT REPORT FOR HOSP. CON'T ;2/27/98 14:24
- ;;4.0;NURSING SERVICE;**9**;Apr 25, 1997
- I 'NHOS S NPFAC="" F S NPFAC=$O(NURSPC(NPFAC)) Q:NPFAC="" S NZ=0 F S NZ=$O(NURSPC(NPFAC,1,NZ)) Q:NZ'>0 S (NURSWARD,NPWARD)=$S($E(NZ,1,3)=999:$E(NZ,4,99),1:NZ) D EN6^NURSAUTL S NPLOC=NPWARD D Q:NURQUIT
- . S NJ=0 F S NJ=$O(NURSPC(NPFAC,1,NZ,NJ)) D:NJ'>0 BRK^NURARWL3 Q:NJ'>0 D BEDSEC,ACUFTE,DETAIL^NURARWL3 Q:NURQUIT
- . Q
- I NHOS S:'NURMDSW NURFAC(2)=" BLANK" D Q:NURQUIT
- . S NDA=0 F S NDA=$O(^NURSF(211.4,NDA)) Q:NDA'>0 S NPWARD=NDA D EN6^NURSAUTL I NPWARD'="" D Q:NURQUIT
- . . I $G(NURFAC(2))'=" BLANK" S NURFAC(2)=$$EN12^NURSUT3($G(NDA)) Q:NURFAC(2)="" I '$G(NURFAC),$G(NURFAC(2))'=$G(NURFAC(1)) Q
- . . S ^TMP($J,"WARD",NURFAC(2),NPWARD,NDA)=""
- . . Q
- . S NPFAC="" F S NPFAC=$O(^TMP($J,"WARD",NPFAC)) Q:NPFAC="" D:'$G(NURSUMSW) HEADER^NURARWL3 D Q:NURQUIT D:NURMDSW FACTOT^NURARWL9
- . . S NPLOC="" F S NPLOC=$O(^TMP($J,"WARD",NPFAC,NPLOC)) Q:NPLOC=""!NURQUIT S NZ=$O(^(NPLOC,"")) I NZ'="",$D(NURSPC(NPFAC,1,NZ)) D Q:NURQUIT
- . . . S NURSWARD=NZ,NJ=0 F S NJ=$O(NURSPC(NPFAC,1,NZ,NJ)) D:NJ'>0 BRK^NURARWL3 Q:NJ'>0 D BEDSEC,ACUFTE,DETAIL^NURARWL3 Q:NURQUIT
- . . . Q
- . . Q
- . Q
- Q
- ACUFTE ;
- F X(1)=1,2,3 S $P(NREQ,U,X(1))=0,$P(NFTEE,U,X(1))=0,$P(NVAR,U,X(1))=0 S $P(NPROD,U,X(1))=$S(NURSZAP'>6:0,1:"")
- S NURS213=^NURSF(213.3,NJ,1),DIC=213.4,DIC(0)="",X=NRPTDAT_NURSHFT_NURSWARD D ^DIC K DIC S NDA=+Y D
- . F Z=1:1:5 Q:'$D(NURSPC(NPFAC,Z,NZ,NJ)) S $P(NPC,U,Z)=NURSPC(NPFAC,Z,NZ,NJ),NPCC=NPCC+$P(NPC,U,Z)
- . S:NTCEN(NZ) NPERCEN=(NPCC/NTCEN(NZ))
- . I NURSHFT="D" S NTLFTEE=(($P(NPC,U)*$P(NURS213,"^",2))+($P(NPC,U,2)*$P(NURS213,"^",3))+($P(NPC,U,3)*$P(NURS213,"^",4))+($P(NPC,U,4)*$P(NURS213,"^",5))+($P(NPC,U,5)*$P(NURS213,"^",14)))/8.5
- . I NURSHFT="E" S NTLFTEE=(($P(NPC,U)*$P(NURS213,"^",6))+($P(NPC,U,2)*$P(NURS213,"^",7))+($P(NPC,U,3)*$P(NURS213,"^",8))+($P(NPC,U,4)*$P(NURS213,"^",9))+($P(NPC,U,5)*$P(NURS213,"^",15)))/8.5
- . I NURSHFT="N" S NTLFTEE=(($P(NPC,U)*$P(NURS213,"^",10))+($P(NPC,U,2)*$P(NURS213,"^",11))+($P(NPC,U,3)*$P(NURS213,"^",12))+($P(NPC,U,4)*$P(NURS213,"^",13))+($P(NPC,U,5)*$P(NURS213,"^",16)))/8
- . S X=$S($D(^NURSA(213.4,NDA,0)):^NURSA(213.4,NDA,0),1:"0^0^0^0") S $P(NFTEE,U)=$S($P(X,"^",2):$P(X,"^",2)/8,1:0) S $P(NFTEE,U,2)=$S($P(X,"^",3):$P(X,"^",3)/8,1:0) S $P(NFTEE,U,3)=$S($P(X,"^",4):$P(X,"^",4)/8,1:0)
- . S X=NTLFTEE I $D(^NURSF(211.4,NURSWARD,1)),$P(^(1),"^",2) S Y=^NURSF(211.4,NURSWARD,1),NTLFTEE("PROF")=X/(100/$P(Y,"^",2)) S NTLFTEE("NPROF")=$S($P(Y,"^",2)<100:X/(100/(100-$P(Y,"^",2))),1:0)
- . E S Y=^DIC(213.9,1,0),NTLFTEE("PROF")=X/(100/$P(Y,"^",7)) S NTLFTEE("NPROF")=$S($P(Y,"^",7)<100:X/(100/(100-$P(Y,"^",7))),1:0)
- . S $P(NREQ,U)=NTLFTEE("PROF"),$P(NREQ,U,2)=NTLFTEE("NPROF")/2,$P(NREQ,U,3)=NTLFTEE("NPROF")/2
- . F X=1:1:3 D
- . . S $P(NDFTEE,U,X)=$S($D(NPERCEN):($P(NFTEE,U,X)*NPERCEN),1:($P(NFTEE,U,X)/NBSEC)) S $P(NVAR,U,X)=$J($P(NDFTEE,U,X),1,1)-$J($P(NREQ,U,X),1,1)
- . . I $J($P(NDFTEE,U,X),1,1),$J($P(NREQ,U,X),1,1),NURSZAP'>6,NPCC S $P(NPROD,U,X)=($J($P(NREQ,U,X),1,1)/$J($P(NDFTEE,U,X),1,1))*100
- . . Q
- . K NPERCEN F X=1:1:3 S $P(NFTEE,U,X)=0
- . Q
- Q
- ADDTOT ; ACCUM. PT. CATEGORY TOT.
- D ^NURSAPCH
- I NURSX="LEAVE"!(NURSX="OTH. FAC.")!(NURSX="AWOL") Q
- D EN6^NURSCUTL S NDATA=$P(^NURSF(214,DFN,0),U,4)
- I NURSADM,NDATA=$O(^NURSF(213.3,"B","DOMICILIARY",0)) S NCAT=1,NBED=NDATA G ADD
- I NDATA=$O(^NURSF(213.3,"B","RECOVERY ROOM",0))!(NDATA=$O(^NURSF(213.3,"B","HEMODIALYSYS",0))) S NCAT=1,NBED=NDATA G ADD
- S RPTDATE=DT,NURSCLAS("CL")=1 D EN2^NURSCUTL
- Q:NURSCLAS="" S NCAT=$S('$D(^NURSA(214.6,NURSCLAS,0)):"",1:$P(^(0),"^",3)),NBED=$S('$D(^NURSA(214.6,NURSCLAS,0)):"",1:$P(^(0),"^",9))
- Q:(NCAT="")!(NBED="") Q:NURSWARD'=$P(^NURSA(214.6,NURSCLAS,0),"^",8)
- ADD ;
- S:'$D(NURSPC(NURFAC(2),NCAT,NURSWARD,NBED)) NURSPC(NURFAC(2),NCAT,NURSWARD,NBED)=0 I $D(NTCEN(NURSWARD)) S NURSPC(NURFAC(2),NCAT,NURSWARD,NBED)=NURSPC(NURFAC(2),NCAT,NURSWARD,NBED)+1,NTCEN(NURSWARD)=(NTCEN(NURSWARD)+1)
- Q
- BEDSEC ;
- S (NBSEC,NI)=0 F S NI=$O(NURSPC(NPFAC,1,NZ,NI)) Q:NI'>0 S NBSEC=NBSEC+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARWL2 4140 printed Feb 18, 2025@23:46:22 Page 2
- NURARWL2 ;HIRMFO/MD-(CURRENT) MANHOURS WORKLOAD STAT REPORT FOR HOSP. CON'T ;2/27/98 14:24
- +1 ;;4.0;NURSING SERVICE;**9**;Apr 25, 1997
- +2 IF 'NHOS
- SET NPFAC=""
- FOR
- SET NPFAC=$ORDER(NURSPC(NPFAC))
- if NPFAC=""
- QUIT
- SET NZ=0
- FOR
- SET NZ=$ORDER(NURSPC(NPFAC,1,NZ))
- if NZ'>0
- QUIT
- SET (NURSWARD,NPWARD)=$SELECT($EXTRACT(NZ,1,3)=999:$EXTRACT(NZ,4,99),1:NZ)
- DO EN6^NURSAUTL
- SET NPLOC=NPWARD
- Begin DoDot:1
- +3 SET NJ=0
- FOR
- SET NJ=$ORDER(NURSPC(NPFAC,1,NZ,NJ))
- if NJ'>0
- DO BRK^NURARWL3
- if NJ'>0
- QUIT
- DO BEDSEC
- DO ACUFTE
- DO DETAIL^NURARWL3
- if NURQUIT
- QUIT
- +4 QUIT
- End DoDot:1
- if NURQUIT
- QUIT
- +5 IF NHOS
- if 'NURMDSW
- SET NURFAC(2)=" BLANK"
- Begin DoDot:1
- +6 SET NDA=0
- FOR
- SET NDA=$ORDER(^NURSF(211.4,NDA))
- if NDA'>0
- QUIT
- SET NPWARD=NDA
- DO EN6^NURSAUTL
- IF NPWARD'=""
- Begin DoDot:2
- +7 IF $GET(NURFAC(2))'=" BLANK"
- SET NURFAC(2)=$$EN12^NURSUT3($GET(NDA))
- if NURFAC(2)=""
- QUIT
- IF '$GET(NURFAC)
- IF $GET(NURFAC(2))'=$GET(NURFAC(1))
- QUIT
- +8 SET ^TMP($JOB,"WARD",NURFAC(2),NPWARD,NDA)=""
- +9 QUIT
- End DoDot:2
- if NURQUIT
- QUIT
- +10 SET NPFAC=""
- FOR
- SET NPFAC=$ORDER(^TMP($JOB,"WARD",NPFAC))
- if NPFAC=""
- QUIT
- if '$GET(NURSUMSW)
- DO HEADER^NURARWL3
- Begin DoDot:2
- +11 SET NPLOC=""
- FOR
- SET NPLOC=$ORDER(^TMP($JOB,"WARD",NPFAC,NPLOC))
- if NPLOC=""!NURQUIT
- QUIT
- SET NZ=$ORDER(^(NPLOC,""))
- IF NZ'=""
- IF $DATA(NURSPC(NPFAC,1,NZ))
- Begin DoDot:3
- +12 SET NURSWARD=NZ
- SET NJ=0
- FOR
- SET NJ=$ORDER(NURSPC(NPFAC,1,NZ,NJ))
- if NJ'>0
- DO BRK^NURARWL3
- if NJ'>0
- QUIT
- DO BEDSEC
- DO ACUFTE
- DO DETAIL^NURARWL3
- if NURQUIT
- QUIT
- +13 QUIT
- End DoDot:3
- if NURQUIT
- QUIT
- +14 QUIT
- End DoDot:2
- if NURQUIT
- QUIT
- if NURMDSW
- DO FACTOT^NURARWL9
- +15 QUIT
- End DoDot:1
- if NURQUIT
- QUIT
- +16 QUIT
- ACUFTE ;
- +1 FOR X(1)=1,2,3
- SET $PIECE(NREQ,U,X(1))=0
- SET $PIECE(NFTEE,U,X(1))=0
- SET $PIECE(NVAR,U,X(1))=0
- SET $PIECE(NPROD,U,X(1))=$SELECT(NURSZAP'>6:0,1:"")
- +2 SET NURS213=^NURSF(213.3,NJ,1)
- SET DIC=213.4
- SET DIC(0)=""
- SET X=NRPTDAT_NURSHFT_NURSWARD
- DO ^DIC
- KILL DIC
- SET NDA=+Y
- Begin DoDot:1
- +3 FOR Z=1:1:5
- if '$DATA(NURSPC(NPFAC,Z,NZ,NJ))
- QUIT
- SET $PIECE(NPC,U,Z)=NURSPC(NPFAC,Z,NZ,NJ)
- SET NPCC=NPCC+$PIECE(NPC,U,Z)
- +4 if NTCEN(NZ)
- SET NPERCEN=(NPCC/NTCEN(NZ))
- +5 IF NURSHFT="D"
- SET NTLFTEE=(($PIECE(NPC,U)*$PIECE(NURS213,"^",2))+($PIECE(NPC,U,2)*$PIECE(NURS213,"^",3))+($PIECE(NPC,U,3)*$PIECE(NURS213,"^",4))+($PIECE(NPC,U,4)*$PIECE(NURS213,"^",5))+($PIECE(NPC,U,5)*$PIECE(NURS213,"^",14)))/8.5
- +6 IF NURSHFT="E"
- SET NTLFTEE=(($PIECE(NPC,U)*$PIECE(NURS213,"^",6))+($PIECE(NPC,U,2)*$PIECE(NURS213,"^",7))+($PIECE(NPC,U,3)*$PIECE(NURS213,"^",8))+($PIECE(NPC,U,4)*$PIECE(NURS213,"^",9))+($PIECE(NPC,U,5)*$PIECE(NURS213,"^",15)))/8.5
- +7 IF NURSHFT="N"
- SET NTLFTEE=(($PIECE(NPC,U)*$PIECE(NURS213,"^",10))+($PIECE(NPC,U,2)*$PIECE(NURS213,"^",11))+($PIECE(NPC,U,3)*$PIECE(NURS213,"^",12))+($PIECE(NPC,U,4)*$PIECE(NURS213,"^",13))+($PIECE(NPC,U,5)*$PIECE(NURS213,"^",16)))/8
- +8 SET X=$SELECT($DATA(^NURSA(213.4,NDA,0)):^NURSA(213.4,NDA,0),1:"0^0^0^0")
- SET $PIECE(NFTEE,U)=$SELECT($PIECE(X,"^",2):$PIECE(X,"^",2)/8,1:0)
- SET $PIECE(NFTEE,U,2)=$SELECT($PIECE(X,"^",3):$PIECE(X,"^",3)/8,1:0)
- SET $PIECE(NFTEE,U,3)=$SELECT($PIECE(X,"^",4):$PIECE(X,"^",4)/8,1:0)
- +9 SET X=NTLFTEE
- IF $DATA(^NURSF(211.4,NURSWARD,1))
- IF $PIECE(^(1),"^",2)
- SET Y=^NURSF(211.4,NURSWARD,1)
- SET NTLFTEE("PROF")=X/(100/$PIECE(Y,"^",2))
- SET NTLFTEE("NPROF")=$SELECT($PIECE(Y,"^",2)<100:X/(100/(100-$PIECE(Y,"^",2))),1:0)
- +10 IF '$TEST
- SET Y=^DIC(213.9,1,0)
- SET NTLFTEE("PROF")=X/(100/$PIECE(Y,"^",7))
- SET NTLFTEE("NPROF")=$SELECT($PIECE(Y,"^",7)<100:X/(100/(100-$PIECE(Y,"^",7))),1:0)
- +11 SET $PIECE(NREQ,U)=NTLFTEE("PROF")
- SET $PIECE(NREQ,U,2)=NTLFTEE("NPROF")/2
- SET $PIECE(NREQ,U,3)=NTLFTEE("NPROF")/2
- +12 FOR X=1:1:3
- Begin DoDot:2
- +13 SET $PIECE(NDFTEE,U,X)=$SELECT($DATA(NPERCEN):($PIECE(NFTEE,U,X)*NPERCEN),1:($PIECE(NFTEE,U,X)/NBSEC))
- SET $PIECE(NVAR,U,X)=$JUSTIFY($PIECE(NDFTEE,U,X),1,1)-$JUSTIFY($PIECE(NREQ,U,X),1,1)
- +14 IF $JUSTIFY($PIECE(NDFTEE,U,X),1,1)
- IF $JUSTIFY($PIECE(NREQ,U,X),1,1)
- IF NURSZAP'>6
- IF NPCC
- SET $PIECE(NPROD,U,X)=($JUSTIFY($PIECE(NREQ,U,X),1,1)/$JUSTIFY($PIECE(NDFTEE,U,X),1,1))*100
- +15 QUIT
- End DoDot:2
- +16 KILL NPERCEN
- FOR X=1:1:3
- SET $PIECE(NFTEE,U,X)=0
- +17 QUIT
- End DoDot:1
- +18 QUIT
- ADDTOT ; ACCUM. PT. CATEGORY TOT.
- +1 DO ^NURSAPCH
- +2 IF NURSX="LEAVE"!(NURSX="OTH. FAC.")!(NURSX="AWOL")
- QUIT
- +3 DO EN6^NURSCUTL
- SET NDATA=$PIECE(^NURSF(214,DFN,0),U,4)
- +4 IF NURSADM
- IF NDATA=$ORDER(^NURSF(213.3,"B","DOMICILIARY",0))
- SET NCAT=1
- SET NBED=NDATA
- GOTO ADD
- +5 IF NDATA=$ORDER(^NURSF(213.3,"B","RECOVERY ROOM",0))!(NDATA=$ORDER(^NURSF(213.3,"B","HEMODIALYSYS",0)))
- SET NCAT=1
- SET NBED=NDATA
- GOTO ADD
- +6 SET RPTDATE=DT
- SET NURSCLAS("CL")=1
- DO EN2^NURSCUTL
- +7 if NURSCLAS=""
- QUIT
- SET NCAT=$SELECT('$DATA(^NURSA(214.6,NURSCLAS,0)):"",1:$PIECE(^(0),"^",3))
- SET NBED=$SELECT('$DATA(^NURSA(214.6,NURSCLAS,0)):"",1:$PIECE(^(0),"^",9))
- +8 if (NCAT="")!(NBED="")
- QUIT
- if NURSWARD'=$PIECE(^NURSA(214.6,NURSCLAS,0),"^",8)
- QUIT
- ADD ;
- +1 if '$DATA(NURSPC(NURFAC(2),NCAT,NURSWARD,NBED))
- SET NURSPC(NURFAC(2),NCAT,NURSWARD,NBED)=0
- IF $DATA(NTCEN(NURSWARD))
- SET NURSPC(NURFAC(2),NCAT,NURSWARD,NBED)=NURSPC(NURFAC(2),NCAT,NURSWARD,NBED)+1
- SET NTCEN(NURSWARD)=(NTCEN(NURSWARD)+1)
- +2 QUIT
- BEDSEC ;
- +1 SET (NBSEC,NI)=0
- FOR
- SET NI=$ORDER(NURSPC(NPFAC,1,NZ,NI))
- if NI'>0
- QUIT
- SET NBSEC=NBSEC+1
- +2 QUIT