[613] | 1 | NURAMB1 ;HIRMFO/MD,FT-BATCH JOB TO UPDATE ACUITY RUN ;2/27/98 14:21
|
---|
| 2 | ;;4.0;NURSING SERVICE;**1,9****;Apr 25, 1997
|
---|
| 3 | EN1 ; ENTRY FROM MANHOUR NIGHT SHIFT ACUITY
|
---|
| 4 | ; SUBROUTINE TO CALCULATE ACUITY FOR HOSPITAL
|
---|
| 5 | S NURTYPE=2,NURDAY=RPTDATE,NURSHFT="N" D EN2^NURAMHU ;purge manhours multiple in 213.9
|
---|
| 6 | ACUIT ; LOOP THROUGH ^TMP($J,"NURCEN") TO STORE LATEST CLASS DATA IN FILE 213.4
|
---|
| 7 | ; SETS NURSDT,NURCENDT AS THE BEGINNING AND ENDING DATES FOR SEARCH
|
---|
| 8 | Q:OUTSW(2) ;quit if night shift acuity already processed
|
---|
| 9 | S NURTIME=$P($G(^DIC(213.9,1,0)),U,6) G:NURTIME="" QUIT ;get night shift acuity time
|
---|
| 10 | S (NURCUTDT,NURCENDT)=+(NURDAY_"."_NURTIME) D ^NURSACEN ; Calculate hospital census at nightshift cutoff time.
|
---|
| 11 | 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
|
---|
| 12 | .S BEDSECT=+$O(^NURSF(213.3,"B","DOMICILIARY",""))
|
---|
| 13 | .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
|
---|
| 14 | .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))
|
---|
| 15 | .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.
|
---|
| 16 | .S CLASS=$P(NURDAT,U,3),BEDSECT=$P(NURDAT,U,9),NCWARD=$P(NURDAT,U,8)
|
---|
| 17 | .S:$L(BEDSECT)=1 BEDSECT="0"_BEDSECT
|
---|
| 18 | .F I=1:1:5 S NCLASS(I)=0
|
---|
| 19 | .S NCLASS(CLASS)=1
|
---|
| 20 | .I $P($G(^NURSF(211.4,NCWARD,1)),U)="A" S SHIFT="N" D FINALLY^NURAAU0 ;process if Patient Care Flag set to ACTIVE
|
---|
| 21 | .S $P(^DIC(213.9,1,"DATE"),U,11,12)=NCWARD_U_DFN ; update last ward & patient processed
|
---|
| 22 | .Q
|
---|
| 23 | D HEMCOUNT^NURAAU3,RECOUNT^NURAAU3
|
---|
| 24 | 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.
|
---|
| 25 | QUIT ;KILL VARIABLES/ROUTINE EXIT POINT
|
---|
| 26 | K ^TMP($J,"NURCEN"),^TMP($J,"NGHT")
|
---|
| 27 | Q
|
---|