ANSEAV ;IHS/OIRM/DSD/CSC - VIEW ACUITY DATA; [ 02/25/98 10:32 AM ]
;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
;;VIEW ACUITY DATA
EN N C,D,I,L,N,P,T,X,Y,Z
F D EN1 Q:$D(DTOUT)!$D(DUOUT)
EXIT K ANSDA,ANSDT,ANSP,ANSS,ANSSH,ANSSTR,ANSUN,ANT,ANSX,ANSADMX,ANSADMY,AST,AST1,DTOUT,DUOUT,ANSDFN
Q
EN1 D HEAD,^ANSUD
Q:'$D(ANSDT)!'$D(ANSSH)!'$D(ANSUN)
F D EN2 Q:$D(DTOUT)!$D(DUOUT)!'$D(ANSDFN)
K DUOUT
Q
EN2 K ANSDFN
D ^ANSUPT
Q:$D(DTOUT)!$D(DUOUT)!'$D(ANSDFN)
S ANSADM=$O(^ANSR("PT",ANSDFN,0))
I ANSADM="" W *7,!!," Not Currently An Inpatient." Q
I ANSADM,ANSUN'=$P(^ANSR(ANSADM,0),U,3) D Q
.W *7,!!," NOT Admitted to this Unit During This Time.",!!
S (ANSADMX,ANSADMY)=""
S ANSADMX=$O(^ANSR(ANSADM,"AT",ANSDT))
I ANSADMX="" D A111A ;Q
I ANSADMX D
.S ANSADMY=$O(^ANSR(ANSADM,"AT",ANSADMX,ANSADMY))
.I ANSADMY=""!('$D(^ANSR(+ANSADMY,"L",1,0)))!($P(ANSADMX,".",2)'=ANSSH) D A111A
D CUR
I $D(^ANSR(ANSADM,"DX")) S ANSDX=^("DX")
D ^ANSEAV1
Q
A111A Q:$P(^ANSR(ANSADM,0),"^",5)'="O"
W *7,!!!,?24,"**** WARNING ****",!!,?5,"This patient's assessment is not up-to-date",!,?5,"for the current date and shift."
W !,?5,"Complete the patient assessment.....(Option 'PA', MAIN MENU)",!,?5,"for current date and shift before proceeding",!,?5,"to ensure correct calculations and reports."
D PAUSE^ANSDIC
Q
CUR S (M,N)=0,X=DT_".9",AT=0
F S M=$O(^ANSR(ANSADM,"AT",M)) Q:M=""!(M>X) D
.S O=0,ANSMR=M
.F S O=$O(^ANSR(ANSADM,"AT",M,O)) Q:O="" D
..I $D(^ANSR(O,0)),$P(^(0),U,5)="D" S A=0
..S N=O
I N=0 D
.W !!,"Initial assessment of this patient has not been completed",!!,"Strike any key to continue..........."
.D PAUSE^ANSDIC
S (ANSCL,ANSAF)=""
I N,$D(^ANSR(N,0)) S ANSDT=$P(^(0),U),ANSSH=$P(^(0),U,2),ANSUN=$P(^(0),U,3)
S M=0
F I=1:1 S M=$O(^ANSR(N,"L",M)) Q:M<1 I $D(^ANSR(N,"L",M,0)) S $P(ANSCL,U,M)=$P(^(0),U,2)
S M=0
F I=1:1 S M=$O(^ANSR(N,"F",M)) Q:M="" I $D(^ANSR(N,"F",M,0)) S ANSAF=$G(ANSAF)_M_U
Q
HEAD ;EP;DISPLAY HEADINGS
K ANSY
D HEAD^ANSMENU ;CSC 10/96
S ANSX="PATIENT ACUITY DATA"
W !!,?80-$L(ANSX)/2,ANSX
Q
SUBH S Y=ANSDT
X ^DD("DD")
W !!!,?6,Y
S Y="",ANSS=$P(ANSPAR,U,5)
I $D(ANSSH) S X=$T(@ANSS),Y=$P($P(X,";;",ANSSH+1),U,2) W ?30,Y," Shift"
I ANSUN,$D(^ANSD(59.1,ANSUN,0)) S Z=$P(^(0),U) W ?56,"Unit ",Z
Q
DISP D HEAD,SUBH
W !
Q
2 ;;1^DAY;;2^NIGHT
3 ;;1^DAY;;2^EVENING;;3^NIGHT
ANSEAV ;IHS/OIRM/DSD/CSC - VIEW ACUITY DATA; [ 02/25/98 10:32 AM ]
+1 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
+2 ;;VIEW ACUITY DATA
EN NEW C,D,I,L,N,P,T,X,Y,Z
+1 FOR
DO EN1
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
EXIT KILL ANSDA,ANSDT,ANSP,ANSS,ANSSH,ANSSTR,ANSUN,ANT,ANSX,ANSADMX,ANSADMY,AST,AST1,DTOUT,DUOUT,ANSDFN
+1 QUIT
EN1 DO HEAD
DO ^ANSUD
+1 IF '$DATA(ANSDT)!'$DATA(ANSSH)!'$DATA(ANSUN)
QUIT
+2 FOR
DO EN2
IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(ANSDFN)
QUIT
+3 KILL DUOUT
+4 QUIT
EN2 KILL ANSDFN
+1 DO ^ANSUPT
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(ANSDFN)
QUIT
+3 SET ANSADM=$ORDER(^ANSR("PT",ANSDFN,0))
+4 IF ANSADM=""
WRITE *7,!!," Not Currently An Inpatient."
QUIT
+5 IF ANSADM
IF ANSUN'=$PIECE(^ANSR(ANSADM,0),U,3)
Begin DoDot:1
+6 WRITE *7,!!," NOT Admitted to this Unit During This Time.",!!
End DoDot:1
QUIT
+7 SET (ANSADMX,ANSADMY)=""
+8 SET ANSADMX=$ORDER(^ANSR(ANSADM,"AT",ANSDT))
+9 ;Q
IF ANSADMX=""
DO A111A
+10 IF ANSADMX
Begin DoDot:1
+11 SET ANSADMY=$ORDER(^ANSR(ANSADM,"AT",ANSADMX,ANSADMY))
+12 IF ANSADMY=""!('$DATA(^ANSR(+ANSADMY,"L",1,0)))!($PIECE(ANSADMX,".",2)'=ANSSH)
DO A111A
End DoDot:1
+13 DO CUR
+14 IF $DATA(^ANSR(ANSADM,"DX"))
SET ANSDX=^("DX")
+15 DO ^ANSEAV1
+16 QUIT
A111A IF $PIECE(^ANSR(ANSADM,0),"^",5)'="O"
QUIT
+1 WRITE *7,!!!,?24,"**** WARNING ****",!!,?5,"This patient's assessment is not up-to-date",!,?5,"for the current date and shift."
+2 WRITE !,?5,"Complete the patient assessment.....(Option 'PA', MAIN MENU)",!,?5,"for current date and shift before proceeding",!,?5,"to ensure correct calculations and reports."
+3 DO PAUSE^ANSDIC
+4 QUIT
CUR SET (M,N)=0
SET X=DT_".9"
SET AT=0
+1 FOR
SET M=$ORDER(^ANSR(ANSADM,"AT",M))
IF M=""!(M>X)
QUIT
Begin DoDot:1
+2 SET O=0
SET ANSMR=M
+3 FOR
SET O=$ORDER(^ANSR(ANSADM,"AT",M,O))
IF O=""
QUIT
Begin DoDot:2
+4 IF $DATA(^ANSR(O,0))
IF $PIECE(^(0),U,5)="D"
SET A=0
+5 SET N=O
End DoDot:2
End DoDot:1
+6 IF N=0
Begin DoDot:1
+7 WRITE !!,"Initial assessment of this patient has not been completed",!!,"Strike any key to continue..........."
+8 DO PAUSE^ANSDIC
End DoDot:1
+9 SET (ANSCL,ANSAF)=""
+10 IF N
IF $DATA(^ANSR(N,0))
SET ANSDT=$PIECE(^(0),U)
SET ANSSH=$PIECE(^(0),U,2)
SET ANSUN=$PIECE(^(0),U,3)
+11 SET M=0
+12 FOR I=1:1
SET M=$ORDER(^ANSR(N,"L",M))
IF M<1
QUIT
IF $DATA(^ANSR(N,"L",M,0))
SET $PIECE(ANSCL,U,M)=$PIECE(^(0),U,2)
+13 SET M=0
+14 FOR I=1:1
SET M=$ORDER(^ANSR(N,"F",M))
IF M=""
QUIT
IF $DATA(^ANSR(N,"F",M,0))
SET ANSAF=$GET(ANSAF)_M_U
+15 QUIT
HEAD ;EP;DISPLAY HEADINGS
+1 KILL ANSY
+2 ;CSC 10/96
DO HEAD^ANSMENU
+3 SET ANSX="PATIENT ACUITY DATA"
+4 WRITE !!,?80-$LENGTH(ANSX)/2,ANSX
+5 QUIT
SUBH SET Y=ANSDT
+1 XECUTE ^DD("DD")
+2 WRITE !!!,?6,Y
+3 SET Y=""
SET ANSS=$PIECE(ANSPAR,U,5)
+4 IF $DATA(ANSSH)
SET X=$TEXT(@ANSS)
SET Y=$PIECE($PIECE(X,";;",ANSSH+1),U,2)
WRITE ?30,Y," Shift"
+5 IF ANSUN
IF $DATA(^ANSD(59.1,ANSUN,0))
SET Z=$PIECE(^(0),U)
WRITE ?56,"Unit ",Z
+6 QUIT
DISP DO HEAD
DO SUBH
+1 WRITE !
+2 QUIT
2 ;;1^DAY;;2^NIGHT
3 ;;1^DAY;;2^EVENING;;3^NIGHT
