ANSQRS ;IHS/OIRM/DSD/CSC - PRINT NURSING UNIT ROSTER; [ 02/25/98 10:32 AM ]
;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
;;PRINT NURSING UNIT ROSTER
EN I '$D(ANSPAR) S ANSPAR=^ANSD(51,1,0)
Q:'$D(ANSUNIT)
D SB1
D ^ANSQRP
W:$G(IOST)["P-" @IOF
Q
SB1 ;CHECH THROUGH ALL CURRENTLY ADMITTED PATIENTS
K ^TMP("ANS",$J)
S ANSDFN=""
S1 F S ANSDFN=$O(^ANSR("PT",ANSDFN)) Q:ANSDFN=""!$D(DTOUT)!$D(DUOUT) D
.S ANSADM=0
S2 .F S ANSADM=$O(^ANSR("PT",ANSDFN,ANSADM)) Q:ANSADM=""!$D(DTOUT)!$D(DUOUT) D
..Q:'$D(^ANSR(ANSADM,0))
..S X=$G(^ANSR(ANSADM,"DX"))
..Q:$P(X,U,2)'=ANSUNIT
..D SET
Q
SET ;DETERMINE THE CARE LEVEL FOR THE PATIENT, ADJUSTMENT FACTORS AND
;SET TEMP GLOBAL FOR PRINTED ROSTER REPORT
S (R,B)="/",Y=$P(X,U,3),(ANSCL,ANSAF,L)=""
;DETERMINE ROOM AND BED
I Y S Y=$P($G(^ANSD(59.1,ANSUNIT,"R",Y,0)),U) D
.S:Y R=Y
.S Y=$P(X,U,4)
.I R,Y,$D(^ANSD(59.1,ANSUNIT,"R",Y,"B",Y,0)) S Y=$P(^(0),U) S:Y B=Y
;FIND LATEST ASSESSMENT
S M=0
F S M=$O(^ANSR(ANSADM,"AT",M)) Q:M=""!$D(DTOUT)!$D(DUOUT) D
.S N=0
.F S N=$O(^ANSR(ANSADM,"AT",M,N)) Q:N=""!$D(DTOUT)!$D(DUOUT) D
..Q:'$D(^ANSR(N,0))
..Q:$P(^ANSR(N,0),U,5)="D"
..S L=N
;IF LATEST ASSESSMENT FOUND SET THE CARE LEVEL
;ANSCL = CARE LEVELS FOR EACH CRITERIA
I L D
.F I=1:1:10 S $P(ANSCL,U,I)=$P($G(^ANSR(L,"L",I,0)),U,2)
.S N=0
.F S N=$O(^ANSR(L,"F",N)) Q:N="" D
..S ANSAF=$G(ANSAF)_N_U
S ^TMP("ANS",$J,R,B,ANSDFN)=X,^(ANSDFN,1)=ANSCL,^(2)=ANSAF
Q
ANSQRS ;IHS/OIRM/DSD/CSC - PRINT NURSING UNIT ROSTER; [ 02/25/98 10:32 AM ]
+1 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
+2 ;;PRINT NURSING UNIT ROSTER
EN IF '$DATA(ANSPAR)
SET ANSPAR=^ANSD(51,1,0)
+1 IF '$DATA(ANSUNIT)
QUIT
+2 DO SB1
+3 DO ^ANSQRP
+4 IF $GET(IOST)["P-"
WRITE @IOF
+5 QUIT
SB1 ;CHECH THROUGH ALL CURRENTLY ADMITTED PATIENTS
+1 KILL ^TMP("ANS",$JOB)
+2 SET ANSDFN=""
S1 FOR
SET ANSDFN=$ORDER(^ANSR("PT",ANSDFN))
IF ANSDFN=""!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:1
+1 SET ANSADM=0
S2 FOR
SET ANSADM=$ORDER(^ANSR("PT",ANSDFN,ANSADM))
IF ANSADM=""!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:2
+1 IF '$DATA(^ANSR(ANSADM,0))
QUIT
+2 SET X=$GET(^ANSR(ANSADM,"DX"))
+3 IF $PIECE(X,U,2)'=ANSUNIT
QUIT
+4 DO SET
End DoDot:2
End DoDot:1
+5 QUIT
SET ;DETERMINE THE CARE LEVEL FOR THE PATIENT, ADJUSTMENT FACTORS AND
+1 ;SET TEMP GLOBAL FOR PRINTED ROSTER REPORT
+2 SET (R,B)="/"
SET Y=$PIECE(X,U,3)
SET (ANSCL,ANSAF,L)=""
+3 ;DETERMINE ROOM AND BED
+4 IF Y
SET Y=$PIECE($GET(^ANSD(59.1,ANSUNIT,"R",Y,0)),U)
Begin DoDot:1
+5 IF Y
SET R=Y
+6 SET Y=$PIECE(X,U,4)
+7 IF R
IF Y
IF $DATA(^ANSD(59.1,ANSUNIT,"R",Y,"B",Y,0))
SET Y=$PIECE(^(0),U)
IF Y
SET B=Y
End DoDot:1
+8 ;FIND LATEST ASSESSMENT
+9 SET M=0
+10 FOR
SET M=$ORDER(^ANSR(ANSADM,"AT",M))
IF M=""!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:1
+11 SET N=0
+12 FOR
SET N=$ORDER(^ANSR(ANSADM,"AT",M,N))
IF N=""!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:2
+13 IF '$DATA(^ANSR(N,0))
QUIT
+14 IF $PIECE(^ANSR(N,0),U,5)="D"
QUIT
+15 SET L=N
End DoDot:2
End DoDot:1
+16 ;IF LATEST ASSESSMENT FOUND SET THE CARE LEVEL
+17 ;ANSCL = CARE LEVELS FOR EACH CRITERIA
+18 IF L
Begin DoDot:1
+19 FOR I=1:1:10
SET $PIECE(ANSCL,U,I)=$PIECE($GET(^ANSR(L,"L",I,0)),U,2)
+20 SET N=0
+21 FOR
SET N=$ORDER(^ANSR(L,"F",N))
IF N=""
QUIT
Begin DoDot:2
+22 SET ANSAF=$GET(ANSAF)_N_U
End DoDot:2
End DoDot:1
+23 SET ^TMP("ANS",$JOB,R,B,ANSDFN)=X
SET ^(ANSDFN,1)=ANSCL
SET ^(2)=ANSAF
+24 QUIT
