- NURARWL1 ;HIRMFO/RM,MD-(CURRENT) MANHOURS WORKLOAD STATISTICS REPORT ;7/29/96
- ;;4.0;NURSING SERVICE;**17**;Apr 25, 1997
- S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
- S (NHOS,NUROUT,NURQUEUE,NURMDSW,NURPLSW)=0 D EN9^NURSAGSP,LOSER^NURARST G QUIT:NUROUT,EN1:SEL=2,EN2:SEL=1
- EN2 ; ENTRY FROM OPTION NURAPR-RES-CWLOC
- G MAINLINE
- EN1 ; ENTRY FROM OPTION NURAPR-RES-CWLSER
- S NHOS=1,NWARD=""
- I NURMDSW D EN12^NURSAGSP G:$G(NUROUT) QUIT W ! S DIC(0)="AEMQZ" D EN8^NURSAGSP I $G(NUROUT) G QUIT
- MAINLINE ;
- S (NPCT,NURQUIT,NSW1)=0,NURS132=1 D EN1^NURSAUTL G QUIT:NUROUT
- I '$P($G(^DIC(213.9,1,0)),U,7) D S DIE=213.9,DA=1,DR="8" D ^DIE K DIE,DR G:U[X QUIT
- .W !,$C(7),?5,"The professional percentage default site parameter, for wards without an",!,?5,"entry in the professional percentage field, in the NURS LOCATION File",!,?5,"entry must be entered: ",!
- .Q
- I '$D(^NURSF(211.4,"ABS")) W !!,$C(7),"To generate this report AMIS Bedsections must be associated with MAS locations",!,"Contact the NURSING ADP Coordinator." G QUIT
- I $S('$D(^DIC(213.9,1,0)):1,'+$P(^(0),U,4):1,'+$P(^(0),U,5):1,'+$P(^(0),U,6):1,1:0) S NUROUT=1 W !!,$C(7),"Missing Site Parameter Cannot continue",! G QUIT
- I 'NHOS D G:NUROUT QUIT
- .S DIC("A")="Enter Unit: ",DIC("S")="I $S('$D(^(""I"")):1,$P(^(""I""),U)'=""I"":1,1:0),$S('$D(^(1)):1,$P(^(1),U)=""A"":1,1:0)",DIC(0)="AQEMZ",DIC=211.4 W ! D ^DIC K DIC
- .I (+Y'>0)!(U[X) S NUROUT=1 Q
- .S NURSWARD=+Y,NURSWARD(1)=Y(0,0)
- .Q
- S NURY(1)=$P(^DIC(213.9,1,0),U,4,6) D NOW^%DTC S NURY(0)=$E($P(%,".",2)_"0001",1,4)
- S NURY(2)=$S(NURY(0)>+$P(NURY(1),U,2)!(NURY(0)'>+$P(NURY(1),U,3)):"N",NURY(0)>+$P(NURY(1),U,3)&((NURY(0)'>+$P(NURY(1),U))):"D",1:"E")
- S NURY=-1 F W !!,"Select (N)ight, (D)ay, or (E)vening Shift: "_NURY(2)_"// " R NURY:DTIME S:'$T NURY="^^" Q:"^^"[NURY S NURY=$$UP^XLFSTR(NURY) D Q:NURY'=""
- .I NURY'="E"&(NURY'="N")&(NURY'="D") W !!,$C(7),"Enter 'D' for Day, 'E' for Evening or 'N' for Night shift" S NURY="" Q
- .Q
- S:NURY="" NURY=NURY(2) S NURSHFT=NURY
- I "^^"[NURY S NUROUT=1 G QUIT
- W ! S NURS132=1 D QUEUE,EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- Q1 ;
- S X=$S(NURY(2)="D"&(NURY="N"):"T+1",NURY(2)="E"&(NURY="N"!(NURY="D")):"T+1",1:"T"),%DT="" D ^%DT S NRPTDAT=+Y I 'NHOS D CALCULAT
- I NHOS F NURSWARD=0:0 S NURSWARD=$O(^NURSF(211.4,"D","A",NURSWARD)) Q:NURSWARD'>0 D CALCULAT
- S K="",K=$O(NURSPC("")) I K="" K K G NODATA
- K ^TMP($J),^TMP("NURVAR",$J) S (COUNTSW,NWCNT,NFCNT,NPCT,NPCC,NBPCC,NFPCC,NHPCC,NCPCC,NWPCC,NAFTEE,DAFTEE,EAFTEE)=0,NBR=1,$P(NURSY,"-",132)=""
- F X="DOM","REC","HEM" S COUNT(X)="",MNHRS(X)="" I NURMDSW,NHOS S MFHRS(X)="",FCOUNT(X)=""
- F X=1:1:5 S $P(NPC,U,X)=0,$P(NBPC,U,X)=0,$P(NWPC,U,X)=0,$P(NFPC,U,X)=0,$P(NHPC,U,X)=0,$P(NCPC,U,X)=0,$P(NHCPC,U,X)=0
- S (NFTEE,NDFTEE,NWREQ,NWVAR,NWPROD,NWFTEE,NHREQ,NHVAR,NHPROD,NHFTEE,NHCVR,NHCPRD,NHCFT)="" S:NURMDSW&(NHOS) (NFREQ,NFVAR,NFPROD,NFFTEE,NFCVR,NFCPRD,NFCFT)=""
- U IO D ^NURARWL2 G:NUROUT QUIT I NHOS,'NURMDSW!($G(NURFAC)) D HTOT^NURARWL8
- D:'$G(NURSUMSW) ENDPG^NURSUT1
- D VAR^NURARWL9
- I 'NHOS D ENDPG^NURSUT1
- I $E(IOST)="C",'NHOS D ^%ZISC K NURSPC W @IOF G MAINLINE
- QUIT ;
- D CLOSE^NURSUT1,^NURAKILL
- Q
- NODATA S NPCT=0,NPWARD=$G(NURSWARD(1)),NPFAC=$S($G(NURFAC)=0:NURFAC(1),1:"") D HEADER^NURARWL3 W !,"THERE IS NO DATA FOR "_$S($G(NURSWARD(1))'="":NURSWARD(1),1:"THIS REPORT.")
- G QUIT
- QUEUE ; QUEUE JOB TO TASKMAN
- S ZTRTN="Q1^NURARWL1"
- S:'NHOS ZTSAVE("NURSWARD")=""
- Q
- CALCULAT ; CALC. PT. CATEGORY TOT.
- I NURMDSW S NURFAC(2)=$$EN12^NURSUT3($G(NURSWARD)) Q:$G(NURFAC(2))=""
- E S NURFAC(2)=" BLANK"
- I NURMDSW,$G(NURFAC(1))'="" Q:$G(NURFAC(1))'=$G(NURFAC(2))
- W:$E(IOST)="C"&($R(100)) "."
- S NI=0 F S NI=$O(^NURSF(211.4,"ABS",NI)) Q:NI'>0 I $D(^NURSF(211.4,"ABS",NI,NURSWARD)) D
- . I $S('$D(^NURSF(211.4,NURSWARD,"I")):1,$P($G(^("I")),U)'="I":1,1:0),$S('$D(^NURSF(211.4,NURSWARD,1)):1,$P($G(^(1)),U)="A":1,1:0) S NZ=0,NZ=NURSWARD F NK=1:1:5 S NURSPC(NURFAC(2),NK,NURSWARD,NI)=0 S NTCEN(NURSWARD)=0
- . Q
- F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",NURSWARD,DFN)) Q:DFN'>0 D:$D(NTCEN(NURSWARD)) ADDTOT^NURARWL2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARWL1 4083 printed Mar 13, 2025@21:24:58 Page 2
- NURARWL1 ;HIRMFO/RM,MD-(CURRENT) MANHOURS WORKLOAD STATISTICS REPORT ;7/29/96
- +1 ;;4.0;NURSING SERVICE;**17**;Apr 25, 1997
- +2 SET X=$GET(^DIC(213.9,1,"OFF"))
- if X=""!(X=1)
- QUIT
- +3 SET (NHOS,NUROUT,NURQUEUE,NURMDSW,NURPLSW)=0
- DO EN9^NURSAGSP
- DO LOSER^NURARST
- if NUROUT
- GOTO QUIT
- if SEL=2
- GOTO EN1
- if SEL=1
- GOTO EN2
- EN2 ; ENTRY FROM OPTION NURAPR-RES-CWLOC
- +1 GOTO MAINLINE
- EN1 ; ENTRY FROM OPTION NURAPR-RES-CWLSER
- +1 SET NHOS=1
- SET NWARD=""
- +2 IF NURMDSW
- DO EN12^NURSAGSP
- if $GET(NUROUT)
- GOTO QUIT
- WRITE !
- SET DIC(0)="AEMQZ"
- DO EN8^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- MAINLINE ;
- +1 SET (NPCT,NURQUIT,NSW1)=0
- SET NURS132=1
- DO EN1^NURSAUTL
- if NUROUT
- GOTO QUIT
- +2 IF '$PIECE($GET(^DIC(213.9,1,0)),U,7)
- Begin DoDot:1
- +3 WRITE !,$CHAR(7),?5,"The professional percentage default site parameter, for wards without an",!,?5,"entry in the professional percentage field, in the NURS LOCATION File",!,?5,"entry must be entered: ",!
- +4 QUIT
- End DoDot:1
- SET DIE=213.9
- SET DA=1
- SET DR="8"
- DO ^DIE
- KILL DIE,DR
- if U[X
- GOTO QUIT
- +5 IF '$DATA(^NURSF(211.4,"ABS"))
- WRITE !!,$CHAR(7),"To generate this report AMIS Bedsections must be associated with MAS locations",!,"Contact the NURSING ADP Coordinator."
- GOTO QUIT
- +6 IF $SELECT('$DATA(^DIC(213.9,1,0)):1,'+$PIECE(^(0),U,4):1,'+$PIECE(^(0),U,5):1,'+$PIECE(^(0),U,6):1,1:0)
- SET NUROUT=1
- WRITE !!,$CHAR(7),"Missing Site Parameter Cannot continue",!
- GOTO QUIT
- +7 IF 'NHOS
- Begin DoDot:1
- +8 SET DIC("A")="Enter Unit: "
- SET DIC("S")="I $S('$D(^(""I"")):1,$P(^(""I""),U)'=""I"":1,1:0),$S('$D(^(1)):1,$P(^(1),U)=""A"":1,1:0)"
- SET DIC(0)="AQEMZ"
- SET DIC=211.4
- WRITE !
- DO ^DIC
- KILL DIC
- +9 IF (+Y'>0)!(U[X)
- SET NUROUT=1
- QUIT
- +10 SET NURSWARD=+Y
- SET NURSWARD(1)=Y(0,0)
- +11 QUIT
- End DoDot:1
- if NUROUT
- GOTO QUIT
- +12 SET NURY(1)=$PIECE(^DIC(213.9,1,0),U,4,6)
- DO NOW^%DTC
- SET NURY(0)=$EXTRACT($PIECE(%,".",2)_"0001",1,4)
- +13 SET NURY(2)=$SELECT(NURY(0)>+$PIECE(NURY(1),U,2)!(NURY(0)'>+$PIECE(NURY(1),U,3)):"N",NURY(0)>+$PIECE(NURY(1),U,3)&((NURY(0)'>+$PIECE(NURY(1),U))):"D",1:"E")
- +14 SET NURY=-1
- FOR
- WRITE !!,"Select (N)ight, (D)ay, or (E)vening Shift: "_NURY(2)_"// "
- READ NURY:DTIME
- if '$TEST
- SET NURY="^^"
- if "^^"[NURY
- QUIT
- SET NURY=$$UP^XLFSTR(NURY)
- Begin DoDot:1
- +15 IF NURY'="E"&(NURY'="N")&(NURY'="D")
- WRITE !!,$CHAR(7),"Enter 'D' for Day, 'E' for Evening or 'N' for Night shift"
- SET NURY=""
- QUIT
- +16 QUIT
- End DoDot:1
- if NURY'=""
- QUIT
- +17 if NURY=""
- SET NURY=NURY(2)
- SET NURSHFT=NURY
- +18 IF "^^"[NURY
- SET NUROUT=1
- GOTO QUIT
- +19 WRITE !
- SET NURS132=1
- DO QUEUE
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- Q1 ;
- +1 SET X=$SELECT(NURY(2)="D"&(NURY="N"):"T+1",NURY(2)="E"&(NURY="N"!(NURY="D")):"T+1",1:"T")
- SET %DT=""
- DO ^%DT
- SET NRPTDAT=+Y
- IF 'NHOS
- DO CALCULAT
- +2 IF NHOS
- FOR NURSWARD=0:0
- SET NURSWARD=$ORDER(^NURSF(211.4,"D","A",NURSWARD))
- if NURSWARD'>0
- QUIT
- DO CALCULAT
- +3 SET K=""
- SET K=$ORDER(NURSPC(""))
- IF K=""
- KILL K
- GOTO NODATA
- +4 KILL ^TMP($JOB),^TMP("NURVAR",$JOB)
- SET (COUNTSW,NWCNT,NFCNT,NPCT,NPCC,NBPCC,NFPCC,NHPCC,NCPCC,NWPCC,NAFTEE,DAFTEE,EAFTEE)=0
- SET NBR=1
- SET $PIECE(NURSY,"-",132)=""
- +5 FOR X="DOM","REC","HEM"
- SET COUNT(X)=""
- SET MNHRS(X)=""
- IF NURMDSW
- IF NHOS
- SET MFHRS(X)=""
- SET FCOUNT(X)=""
- +6 FOR X=1:1:5
- SET $PIECE(NPC,U,X)=0
- SET $PIECE(NBPC,U,X)=0
- SET $PIECE(NWPC,U,X)=0
- SET $PIECE(NFPC,U,X)=0
- SET $PIECE(NHPC,U,X)=0
- SET $PIECE(NCPC,U,X)=0
- SET $PIECE(NHCPC,U,X)=0
- +7 SET (NFTEE,NDFTEE,NWREQ,NWVAR,NWPROD,NWFTEE,NHREQ,NHVAR,NHPROD,NHFTEE,NHCVR,NHCPRD,NHCFT)=""
- if NURMDSW&(NHOS)
- SET (NFREQ,NFVAR,NFPROD,NFFTEE,NFCVR,NFCPRD,NFCFT)=""
- +8 USE IO
- DO ^NURARWL2
- if NUROUT
- GOTO QUIT
- IF NHOS
- IF 'NURMDSW!($GET(NURFAC))
- DO HTOT^NURARWL8
- +9 if '$GET(NURSUMSW)
- DO ENDPG^NURSUT1
- +10 DO VAR^NURARWL9
- +11 IF 'NHOS
- DO ENDPG^NURSUT1
- +12 IF $EXTRACT(IOST)="C"
- IF 'NHOS
- DO ^%ZISC
- KILL NURSPC
- WRITE @IOF
- GOTO MAINLINE
- QUIT ;
- +1 DO CLOSE^NURSUT1
- DO ^NURAKILL
- +2 QUIT
- NODATA SET NPCT=0
- SET NPWARD=$GET(NURSWARD(1))
- SET NPFAC=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- DO HEADER^NURARWL3
- WRITE !,"THERE IS NO DATA FOR "_$SELECT($GET(NURSWARD(1))'="":NURSWARD(1),1:"THIS REPORT.")
- +1 GOTO QUIT
- QUEUE ; QUEUE JOB TO TASKMAN
- +1 SET ZTRTN="Q1^NURARWL1"
- +2 if 'NHOS
- SET ZTSAVE("NURSWARD")=""
- +3 QUIT
- CALCULAT ; CALC. PT. CATEGORY TOT.
- +1 IF NURMDSW
- SET NURFAC(2)=$$EN12^NURSUT3($GET(NURSWARD))
- if $GET(NURFAC(2))=""
- QUIT
- +2 IF '$TEST
- SET NURFAC(2)=" BLANK"
- +3 IF NURMDSW
- IF $GET(NURFAC(1))'=""
- if $GET(NURFAC(1))'=$GET(NURFAC(2))
- QUIT
- +4 if $EXTRACT(IOST)="C"&($RANDOM(100))
- WRITE "."
- +5 SET NI=0
- FOR
- SET NI=$ORDER(^NURSF(211.4,"ABS",NI))
- if NI'>0
- QUIT
- IF $DATA(^NURSF(211.4,"ABS",NI,NURSWARD))
- Begin DoDot:1
- +6 IF $SELECT('$DATA(^NURSF(211.4,NURSWARD,"I")):1,$PIECE($GET(^("I")),U)'="I":1,1:0)
- IF $SELECT('$DATA(^NURSF(211.4,NURSWARD,1)):1,$PIECE($GET(^(1)),U)="A":1,1:0)
- SET NZ=0
- SET NZ=NURSWARD
- FOR NK=1:1:5
- SET NURSPC(NURFAC(2),NK,NURSWARD,NI)=0
- SET NTCEN(NURSWARD)=0
- +7 QUIT
- End DoDot:1
- +8 FOR DFN=0:0
- SET DFN=$ORDER(^NURSF(214,"AF","A",NURSWARD,DFN))
- if DFN'>0
- QUIT
- if $DATA(NTCEN(NURSWARD))
- DO ADDTOT^NURARWL2
- +9 QUIT
