NURAMB1 ;HIRMFO/MD,FT-BATCH JOB TO UPDATE ACUITY RUN ;2/27/98 14:21
;;4.0;NURSING SERVICE;**1,9****;Apr 25, 1997
EN1 ; ENTRY FROM MANHOUR NIGHT SHIFT ACUITY
; SUBROUTINE TO CALCULATE ACUITY FOR HOSPITAL
S NURTYPE=2,NURDAY=RPTDATE,NURSHFT="N" D EN2^NURAMHU ;purge manhours multiple in 213.9
ACUIT ; LOOP THROUGH ^TMP($J,"NURCEN") TO STORE LATEST CLASS DATA IN FILE 213.4
; SETS NURSDT,NURCENDT AS THE BEGINNING AND ENDING DATES FOR SEARCH
Q:OUTSW(2) ;quit if night shift acuity already processed
S NURTIME=$P($G(^DIC(213.9,1,0)),U,6) G:NURTIME="" QUIT ;get night shift acuity time
S (NURCUTDT,NURCENDT)=+(NURDAY_"."_NURTIME) D ^NURSACEN ; Calculate hospital census at nightshift cutoff time.
F NLOC=NWARD(2):0 S NLOC=$O(^TMP($J,"NURCEN",NLOC)) Q:NLOC'>0 F DFN=DFN(2):0 S DFN=$O(^TMP($J,"NURCEN",NLOC,DFN)) Q:DFN'>0 D
.S BEDSECT=+$O(^NURSF(213.3,"B","DOMICILIARY",""))
.I $D(^NURSF(211.4,"ABS",BEDSECT,NLOC)) S SHIFT="N",NBEDSECT=$E("00"_BEDSECT,1+$L(BEDSECT),2+$L(BEDSECT)),(NWARD,NCWARD)=NLOC D DOMRECNT^NURAAU2 Q
.W:$E(IOST)="C" "." D EN6^NURSCUTL S NURSCLAS("CL")=2,NURSCLAS("WARD")=NLOC D EN2^NURSCUTL S NURDAT=$G(^NURSA(214.6,+NURSCLAS,0))
.Q:$P(NURDAT,U,3)=""!($P(NURDAT,U,8)="")!($P(NURDAT,U,9)="")!($P(NURDAT,U,8)'=NLOC) ; do not process if category or unit or bedsection is missing or the classification unit is different from patient's current unit.
.S CLASS=$P(NURDAT,U,3),BEDSECT=$P(NURDAT,U,9),NCWARD=$P(NURDAT,U,8)
.S:$L(BEDSECT)=1 BEDSECT="0"_BEDSECT
.F I=1:1:5 S NCLASS(I)=0
.S NCLASS(CLASS)=1
.I $P($G(^NURSF(211.4,NCWARD,1)),U)="A" S SHIFT="N" D FINALLY^NURAAU0 ;process if Patient Care Flag set to ACTIVE
.S $P(^DIC(213.9,1,"DATE"),U,11,12)=NCWARD_U_DFN ; update last ward & patient processed
.Q
D HEMCOUNT^NURAAU3,RECOUNT^NURAAU3
S $P(^DIC(213.9,1,"DATE"),U,10)=1,$P(^("DATE"),U,11)=0,$P(^("DATE"),U,12)=0 ;mark night shift processing as complete and night shift ward and patient as zero.
QUIT ;KILL VARIABLES/ROUTINE EXIT POINT
K ^TMP($J,"NURCEN"),^TMP($J,"NGHT")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAMB1 2042 printed Nov 22, 2024@17:29:31 Page 2
NURAMB1 ;HIRMFO/MD,FT-BATCH JOB TO UPDATE ACUITY RUN ;2/27/98 14:21
+1 ;;4.0;NURSING SERVICE;**1,9****;Apr 25, 1997
EN1 ; ENTRY FROM MANHOUR NIGHT SHIFT ACUITY
+1 ; SUBROUTINE TO CALCULATE ACUITY FOR HOSPITAL
+2 ;purge manhours multiple in 213.9
SET NURTYPE=2
SET NURDAY=RPTDATE
SET NURSHFT="N"
DO EN2^NURAMHU
ACUIT ; LOOP THROUGH ^TMP($J,"NURCEN") TO STORE LATEST CLASS DATA IN FILE 213.4
+1 ; SETS NURSDT,NURCENDT AS THE BEGINNING AND ENDING DATES FOR SEARCH
+2 ;quit if night shift acuity already processed
if OUTSW(2)
QUIT
+3 ;get night shift acuity time
SET NURTIME=$PIECE($GET(^DIC(213.9,1,0)),U,6)
if NURTIME=""
GOTO QUIT
+4 ; Calculate hospital census at nightshift cutoff time.
SET (NURCUTDT,NURCENDT)=+(NURDAY_"."_NURTIME)
DO ^NURSACEN
+5 FOR NLOC=NWARD(2):0
SET NLOC=$ORDER(^TMP($JOB,"NURCEN",NLOC))
if NLOC'>0
QUIT
FOR DFN=DFN(2):0
SET DFN=$ORDER(^TMP($JOB,"NURCEN",NLOC,DFN))
if DFN'>0
QUIT
Begin DoDot:1
+6 SET BEDSECT=+$ORDER(^NURSF(213.3,"B","DOMICILIARY",""))
+7 IF $DATA(^NURSF(211.4,"ABS",BEDSECT,NLOC))
SET SHIFT="N"
SET NBEDSECT=$EXTRACT("00"_BEDSECT,1+$LENGTH(BEDSECT),2+$LENGTH(BEDSECT))
SET (NWARD,NCWARD)=NLOC
DO DOMRECNT^NURAAU2
QUIT
+8 if $EXTRACT(IOST)="C"
WRITE "."
DO EN6^NURSCUTL
SET NURSCLAS("CL")=2
SET NURSCLAS("WARD")=NLOC
DO EN2^NURSCUTL
SET NURDAT=$GET(^NURSA(214.6,+NURSCLAS,0))
+9 ; do not process if category or unit or bedsection is missing or the classification unit is different from patient's current unit.
if $PIECE(NURDAT,U,3)=""!($PIECE(NURDAT,U,8)="")!($PIECE(NURDAT,U,9)="")!($PIECE(NURDAT,U,8)'=NLOC)
QUIT
+10 SET CLASS=$PIECE(NURDAT,U,3)
SET BEDSECT=$PIECE(NURDAT,U,9)
SET NCWARD=$PIECE(NURDAT,U,8)
+11 if $LENGTH(BEDSECT)=1
SET BEDSECT="0"_BEDSECT
+12 FOR I=1:1:5
SET NCLASS(I)=0
+13 SET NCLASS(CLASS)=1
+14 ;process if Patient Care Flag set to ACTIVE
IF $PIECE($GET(^NURSF(211.4,NCWARD,1)),U)="A"
SET SHIFT="N"
DO FINALLY^NURAAU0
+15 ; update last ward & patient processed
SET $PIECE(^DIC(213.9,1,"DATE"),U,11,12)=NCWARD_U_DFN
+16 QUIT
End DoDot:1
+17 DO HEMCOUNT^NURAAU3
DO RECOUNT^NURAAU3
+18 ;mark night shift processing as complete and night shift ward and patient as zero.
SET $PIECE(^DIC(213.9,1,"DATE"),U,10)=1
SET $PIECE(^("DATE"),U,11)=0
SET $PIECE(^("DATE"),U,12)=0
QUIT ;KILL VARIABLES/ROUTINE EXIT POINT
+1 KILL ^TMP($JOB,"NURCEN"),^TMP($JOB,"NGHT")
+2 QUIT
