NURAMB1.m

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

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