ANSQSS ;IHS/OIRM/DSD/CSC - CALCULATE NURSE STAFFING STATS; [ 02/25/98 10:32 AM ]
;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
;;CALCULATE NURSE STAFFING STATS
EN ;CHECK THROUGH ALL NUSRING RECORDS BY DATE OF RECORD
K ^TMP("ANS",$J)
D LEVELS
D FACTORS
S ANSD=ANSBDT-1
F S ANSD=$O(^ANSR("B",ANSD)) Q:'ANSD!(ANSD>ANSEDT) D EN1 ;CSC 12-97
D B1
Q
EN1 ;CHECK THROUGH EACH RECORD FOR SPECIFIED DATE
;IF THE RECORD MATCHES THE UNIT FOR WHICH THE REPORT IS REQUESTED
;EVALUATE THE RECORD
;ANSD = DATE
;ANSN = IEN OF THE NURSING RECORD
;ANSUNIT = NURSING UNIT FOR THE REQUESTED REPORT
S ANSN=0
F S ANSN=$O(^ANSR("B",ANSD,ANSN)) Q:ANSN="" D
.Q:$P($G(^ANSR(ANSN,0)),U,3)'=ANSUNIT
.S X=^ANSR(ANSN,0),ANSSH=$P(X,U,2),ANSTY=$P(X,U,5)
.I ANSTY'="O" D DC:ANSTY="D",ADM:ANSTY="A" Q
.D SBCL
.I ANSCL S P=ANSCL,S="O",A=1 D SBADD
Q
ADM ;SET INFO FOR EACH ADMISSION
S ANSCL=1,L=0,M=99,D=$O(^ANSR(ANSN,"AT",0))
I D F S N=$O(^ANSR(ANSN,"AT",D,N)) Q:N<1 D
.I $D(^ANSR(N,0)),$P(^(0),U,5)="O" S S=$P(^(0),U,2) I S,S<M S M=S,L=N
I L S ANSX=ANSN,ANSN=L D SBCL S ANSN=ANSX
S P=ANSCL,S="A",A=1
S:'P P=1
D SBADD
Q
DC ;SET INFO FOR EACH DISCHARGE
S P=7,S="O",A=1
D SBADD
Q
B1 ;CALCULATE THE TOTAL NURSING HOURS AVAILABLE AND TOTALS FOR EACH DAY
S ANSD=ANSBDT-1
F S ANSD=$O(^ANS("AU",ANSD)) Q:ANSD=""!(ANSD>ANSEDT) D B3
D ^ANSQSS1
Q
B3 ;CALCULATE NURSING HOURS AVAILABLE
S ANSSH=""
F S ANSSH=$O(^ANS("AU",ANSD,ANSUNIT,ANSSH)) Q:ANSSH="" D
.S ANSN=""
.F S ANSN=$O(^ANS("AU",ANSD,ANSUNIT,ANSSH,ANSN)) Q:ANSN="" D
..Q:'$D(^ANS(ANSN,0)) S A=$P(^(0),U,4)+$P(^(0),U,5),P=1,S="H"
..D SBADD
..S L=0,N=0
..F I=1:1 S N=$O(^ANS(ANSN,"N",N)) Q:N<1 I $D(^(N,0)) S L=L+$P(^(0),U,2)
..S A=L,P=2,S="H" D SBADD
Q
SBADD ;SET TEMP GLOBAL WITH INFO FOR REPORT
;S = "A" FOR ADMISSION, "O" FOR OBSERVATION, "H" HOURS AVAILABLE
;P = PIECE AT WHICH DATA IS TO BE STORED
;A = VALUE TO BE ADDED TO THE GLOBAL NODE
S $P(^TMP("ANS",$J,ANSD,ANSSH,S),U,P)=$P($G(^TMP("ANS",$J,ANSD,ANSSH,S)),U,P)+A
Q
SBCL ;CALCULATE THE LEVEL OF CARE FOR THE NURSING RECORD
;ANSCL = CARE LEVEL
;N = LEVEL & NUMBER OF POINTS FOR EACH OF THE 10 CRITERION
;L = TOTAL NUMBER OF POINTS
S (L,ANSCL)=0
F I=1:1:10 I $D(^ANSR(ANSN,"L",I,0)) S N=$P(^(0),U,2) D:N
.S X=$G(^ANSD(59,N,0))
.I N>4,$P(X,U,N) S N=$P(X,U,N)
.S L=L+N
S N=0
F S N=$O(^ANSR(ANSN,"F",N)) Q:N<1 I $D(ANSF(+N)) S F=ANSF(+N) S:F="+" L=L+4 S:F="-" L=L-4
S L=$O(ANSL(L-1))
I L S ANSCL=ANSL(L)
Q
LEVELS ;SET ARRAYS OF CARE LEVEL INFORMATION
;L = NUMBER OF POINTS PER LEVEL
;ANSL(L) = ARRAY OF LEVELS BY NUMBER OF POINTS PER LEVEL
;ANSH(L) = ARRAY OF LEVELS BY LEVEL NUMBER (1-6)
;ANSA(L) = ARRAY OF LEVELS BY HOURS REQUIRED FOR ADMISSION
S N=0
F S N=$O(^ANSD(51.1,1,"K",N)) Q:N<1 D
.S X=$G(^ANSD(51.1,1,"K",N,0))
.S:X]"" L=$P(X,U,5),ANSL(N)=L,ANSH(L)=$P(X,U,4),ANSA(L)=$P(X,U,6)
Q
FACTORS ;SETS ARRAY OF ADJUSTMENT FACTORS
;N = IEN OF THE ADJUSTMENT FACTOR
;S = WHETHER THE FACTOR ADDS '+' OR DECREASES '-' NURSING TIME REQUIRED
S N=0
F S N=$O(^ANSD(59.3,N)) Q:N<1 S S=$P($G(^(N,0)),U,3) S:S]"" ANSF(N)=S
Q
ANSQSS ;IHS/OIRM/DSD/CSC - CALCULATE NURSE STAFFING STATS; [ 02/25/98 10:32 AM ]
+1 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
+2 ;;CALCULATE NURSE STAFFING STATS
EN ;CHECK THROUGH ALL NUSRING RECORDS BY DATE OF RECORD
+1 KILL ^TMP("ANS",$JOB)
+2 DO LEVELS
+3 DO FACTORS
+4 SET ANSD=ANSBDT-1
+5 ;CSC 12-97
FOR
SET ANSD=$ORDER(^ANSR("B",ANSD))
IF 'ANSD!(ANSD>ANSEDT)
QUIT
DO EN1
+6 DO B1
+7 QUIT
EN1 ;CHECK THROUGH EACH RECORD FOR SPECIFIED DATE
+1 ;IF THE RECORD MATCHES THE UNIT FOR WHICH THE REPORT IS REQUESTED
+2 ;EVALUATE THE RECORD
+3 ;ANSD = DATE
+4 ;ANSN = IEN OF THE NURSING RECORD
+5 ;ANSUNIT = NURSING UNIT FOR THE REQUESTED REPORT
+6 SET ANSN=0
+7 FOR
SET ANSN=$ORDER(^ANSR("B",ANSD,ANSN))
IF ANSN=""
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^ANSR(ANSN,0)),U,3)'=ANSUNIT
QUIT
+9 SET X=^ANSR(ANSN,0)
SET ANSSH=$PIECE(X,U,2)
SET ANSTY=$PIECE(X,U,5)
+10 IF ANSTY'="O"
IF ANSTY="D"
DO DC
IF ANSTY="A"
DO ADM
QUIT
+11 DO SBCL
+12 IF ANSCL
SET P=ANSCL
SET S="O"
SET A=1
DO SBADD
End DoDot:1
+13 QUIT
ADM ;SET INFO FOR EACH ADMISSION
+1 SET ANSCL=1
SET L=0
SET M=99
SET D=$ORDER(^ANSR(ANSN,"AT",0))
+2 IF D
FOR
SET N=$ORDER(^ANSR(ANSN,"AT",D,N))
IF N<1
QUIT
Begin DoDot:1
+3 IF $DATA(^ANSR(N,0))
IF $PIECE(^(0),U,5)="O"
SET S=$PIECE(^(0),U,2)
IF S
IF S<M
SET M=S
SET L=N
End DoDot:1
+4 IF L
SET ANSX=ANSN
SET ANSN=L
DO SBCL
SET ANSN=ANSX
+5 SET P=ANSCL
SET S="A"
SET A=1
+6 IF 'P
SET P=1
+7 DO SBADD
+8 QUIT
DC ;SET INFO FOR EACH DISCHARGE
+1 SET P=7
SET S="O"
SET A=1
+2 DO SBADD
+3 QUIT
B1 ;CALCULATE THE TOTAL NURSING HOURS AVAILABLE AND TOTALS FOR EACH DAY
+1 SET ANSD=ANSBDT-1
+2 FOR
SET ANSD=$ORDER(^ANS("AU",ANSD))
IF ANSD=""!(ANSD>ANSEDT)
QUIT
DO B3
+3 DO ^ANSQSS1
+4 QUIT
B3 ;CALCULATE NURSING HOURS AVAILABLE
+1 SET ANSSH=""
+2 FOR
SET ANSSH=$ORDER(^ANS("AU",ANSD,ANSUNIT,ANSSH))
IF ANSSH=""
QUIT
Begin DoDot:1
+3 SET ANSN=""
+4 FOR
SET ANSN=$ORDER(^ANS("AU",ANSD,ANSUNIT,ANSSH,ANSN))
IF ANSN=""
QUIT
Begin DoDot:2
+5 IF '$DATA(^ANS(ANSN,0))
QUIT
SET A=$PIECE(^(0),U,4)+$PIECE(^(0),U,5)
SET P=1
SET S="H"
+6 DO SBADD
+7 SET L=0
SET N=0
+8 FOR I=1:1
SET N=$ORDER(^ANS(ANSN,"N",N))
IF N<1
QUIT
IF $DATA(^(N,0))
SET L=L+$PIECE(^(0),U,2)
+9 SET A=L
SET P=2
SET S="H"
DO SBADD
End DoDot:2
End DoDot:1
+10 QUIT
SBADD ;SET TEMP GLOBAL WITH INFO FOR REPORT
+1 ;S = "A" FOR ADMISSION, "O" FOR OBSERVATION, "H" HOURS AVAILABLE
+2 ;P = PIECE AT WHICH DATA IS TO BE STORED
+3 ;A = VALUE TO BE ADDED TO THE GLOBAL NODE
+4 SET $PIECE(^TMP("ANS",$JOB,ANSD,ANSSH,S),U,P)=$PIECE($GET(^TMP("ANS",$JOB,ANSD,ANSSH,S)),U,P)+A
+5 QUIT
SBCL ;CALCULATE THE LEVEL OF CARE FOR THE NURSING RECORD
+1 ;ANSCL = CARE LEVEL
+2 ;N = LEVEL & NUMBER OF POINTS FOR EACH OF THE 10 CRITERION
+3 ;L = TOTAL NUMBER OF POINTS
+4 SET (L,ANSCL)=0
+5 FOR I=1:1:10
IF $DATA(^ANSR(ANSN,"L",I,0))
SET N=$PIECE(^(0),U,2)
IF N
Begin DoDot:1
+6 SET X=$GET(^ANSD(59,N,0))
+7 IF N>4
IF $PIECE(X,U,N)
SET N=$PIECE(X,U,N)
+8 SET L=L+N
End DoDot:1
+9 SET N=0
+10 FOR
SET N=$ORDER(^ANSR(ANSN,"F",N))
IF N<1
QUIT
IF $DATA(ANSF(+N))
SET F=ANSF(+N)
IF F="+"
SET L=L+4
IF F="-"
SET L=L-4
+11 SET L=$ORDER(ANSL(L-1))
+12 IF L
SET ANSCL=ANSL(L)
+13 QUIT
LEVELS ;SET ARRAYS OF CARE LEVEL INFORMATION
+1 ;L = NUMBER OF POINTS PER LEVEL
+2 ;ANSL(L) = ARRAY OF LEVELS BY NUMBER OF POINTS PER LEVEL
+3 ;ANSH(L) = ARRAY OF LEVELS BY LEVEL NUMBER (1-6)
+4 ;ANSA(L) = ARRAY OF LEVELS BY HOURS REQUIRED FOR ADMISSION
+5 SET N=0
+6 FOR
SET N=$ORDER(^ANSD(51.1,1,"K",N))
IF N<1
QUIT
Begin DoDot:1
+7 SET X=$GET(^ANSD(51.1,1,"K",N,0))
+8 IF X]""
SET L=$PIECE(X,U,5)
SET ANSL(N)=L
SET ANSH(L)=$PIECE(X,U,4)
SET ANSA(L)=$PIECE(X,U,6)
End DoDot:1
+9 QUIT
FACTORS ;SETS ARRAY OF ADJUSTMENT FACTORS
+1 ;N = IEN OF THE ADJUSTMENT FACTOR
+2 ;S = WHETHER THE FACTOR ADDS '+' OR DECREASES '-' NURSING TIME REQUIRED
+3 SET N=0
+4 FOR
SET N=$ORDER(^ANSD(59.3,N))
IF N<1
QUIT
SET S=$PIECE($GET(^(N,0)),U,3)
IF S]""
SET ANSF(N)=S
+5 QUIT
