- 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
