ANSEA ;IHS/OIRM/DSD/CSC - ENTER/EDIT ACUITY DATA; [ 02/25/98 10:32 AM ]
;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
;ENTRY POINT TO ADD OR EDIT PATIENT ACUITY DATA
EN N C,D,I,L,N,P,T,X,Y,Z
K ANSDT
F D EN1 Q:$D(DTOUT)!$D(DUOUT)
EXIT K ANS,ANSDA,ANSDT,ANSP,ANSS,ANSSH,ANSSTR,ANSUN,ANT,ANSX
Q
EN1 D HEAD,^ANSUD
Q:'$D(ANSUN)!'$D(ANSDT)!'$D(ANSSH)
F D EN2 Q:$D(DTOUT)!$D(DUOUT)!'$D(ANSDFN)
K DTOUT,DUOUT
Q
EN2 D DISP
K ANSDFN,DTOUT,DUOUT
D ^ANSUPT
Q:$D(DTOUT)!$D(DUOUT)!'$D(ANSDFN)
D FIND
I '$D(^ANSR(+ANSADM,0)) D Q
.W *7,!!," NOT An Inpatient During This Time."
.D PAUSE^ANSDIC
I ANSUN'=$P(^ANSR(ANSADM,0),U,3) D Q
.W *7,!!," NOT Admitted to this Unit During This Time."
.D PAUSE^ANSDIC
D CUR
D ^ANSEA1
K DUOUT,DTOUT
Q
FIND ;FIND MOST RECENT ADMISSION
S I=9999998-ANSDT,ANSADM=0,W=ANSDT_"."_ANSSH
F S I=$O(^ANSR("AA",ANSDFN,I)) Q:'I D
.S N=0
.F S N=$O(^ANSR("AA",ANSDFN,I,N)) Q:'N!ANSADM D
..S A=$P(^ANSR(N,0),U)_"."_$P(^(0),U,2),E=$P($G(^("DX")),U,5)
..S D=DT_".9"
..I E,$D(^ANSR(E,0)) S D=$P(^(0),U)_"."_$P(^(0),U,2)
..I W'<A,W'>D S ANSADM=N
Q
CUR ;DATA FOR CURRENT ADMISSION
S (A,ANSDA,N,M)=0,X=ANSDT_"."_ANSSH
S ANSMR=$P(^ANSR(ANSADM,0),U)_"."_$P(^(0),U,2)
F I=1:1 S M=$O(^ANSR(ANSADM,"AT",X,M)) Q:M="" I $D(^ANSR(M,0)),$P(^(0),U,5)="O" S (N,ANSDA)=M
S M=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="" I $D(^ANSR(O,0)) D
..I $P(^ANSR(O,0),U,5)="D" S A=0 Q
..S N=O
S (ANSCL,ANSAF,ANSDX)=""
I ANSDA S N=ANSDA
I $O(^ANSR(ANSADM,"AT",X))="" S ANSDX=$G(^ANSR(ANSADM,"DX")) I $P(ANSDX,U,2)'=ANSUN S ANSDX=$P(ANSDX,U)
Q:'N
S M=0
F S M=$O(^ANSR(N,"L",M)) Q:M<1 D
.S $P(ANSCL,U,M)=$P($G(^ANSR(N,"L",M,0)),U,2)
S M=0
F S M=$O(^ANSR(N,"F",M)) Q:M="" D
.I $D(^ANSR(N,"F",M,0)) S ANSAF=$G(ANSAF)_M_U
Q
HEAD D ^ANSMENU
S ANSX="PATIENT ACUITY ASSESSMENT"
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
Q
2 ;;1^DAY;;2^NIGHT
3 ;;1^DAY;;2^EVENING;;3^NIGHT
ANSEA ;IHS/OIRM/DSD/CSC - ENTER/EDIT ACUITY DATA; [ 02/25/98 10:32 AM ]
+1 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
+2 ;ENTRY POINT TO ADD OR EDIT PATIENT ACUITY DATA
EN NEW C,D,I,L,N,P,T,X,Y,Z
+1 KILL ANSDT
+2 FOR
DO EN1
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
EXIT KILL ANS,ANSDA,ANSDT,ANSP,ANSS,ANSSH,ANSSTR,ANSUN,ANT,ANSX
+1 QUIT
EN1 DO HEAD
DO ^ANSUD
+1 IF '$DATA(ANSUN)!'$DATA(ANSDT)!'$DATA(ANSSH)
QUIT
+2 FOR
DO EN2
IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(ANSDFN)
QUIT
+3 KILL DTOUT,DUOUT
+4 QUIT
EN2 DO DISP
+1 KILL ANSDFN,DTOUT,DUOUT
+2 DO ^ANSUPT
+3 IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(ANSDFN)
QUIT
+4 DO FIND
+5 IF '$DATA(^ANSR(+ANSADM,0))
Begin DoDot:1
+6 WRITE *7,!!," NOT An Inpatient During This Time."
+7 DO PAUSE^ANSDIC
End DoDot:1
QUIT
+8 IF ANSUN'=$PIECE(^ANSR(ANSADM,0),U,3)
Begin DoDot:1
+9 WRITE *7,!!," NOT Admitted to this Unit During This Time."
+10 DO PAUSE^ANSDIC
End DoDot:1
QUIT
+11 DO CUR
+12 DO ^ANSEA1
+13 KILL DUOUT,DTOUT
+14 QUIT
FIND ;FIND MOST RECENT ADMISSION
+1 SET I=9999998-ANSDT
SET ANSADM=0
SET W=ANSDT_"."_ANSSH
+2 FOR
SET I=$ORDER(^ANSR("AA",ANSDFN,I))
IF 'I
QUIT
Begin DoDot:1
+3 SET N=0
+4 FOR
SET N=$ORDER(^ANSR("AA",ANSDFN,I,N))
IF 'N!ANSADM
QUIT
Begin DoDot:2
+5 SET A=$PIECE(^ANSR(N,0),U)_"."_$PIECE(^(0),U,2)
SET E=$PIECE($GET(^("DX")),U,5)
+6 SET D=DT_".9"
+7 IF E
IF $DATA(^ANSR(E,0))
SET D=$PIECE(^(0),U)_"."_$PIECE(^(0),U,2)
+8 IF W'<A
IF W'>D
SET ANSADM=N
End DoDot:2
End DoDot:1
+9 QUIT
CUR ;DATA FOR CURRENT ADMISSION
+1 SET (A,ANSDA,N,M)=0
SET X=ANSDT_"."_ANSSH
+2 SET ANSMR=$PIECE(^ANSR(ANSADM,0),U)_"."_$PIECE(^(0),U,2)
+3 FOR I=1:1
SET M=$ORDER(^ANSR(ANSADM,"AT",X,M))
IF M=""
QUIT
IF $DATA(^ANSR(M,0))
IF $PIECE(^(0),U,5)="O"
SET (N,ANSDA)=M
+4 SET M=0
+5 FOR
SET M=$ORDER(^ANSR(ANSADM,"AT",M))
IF M=""!(M>X)
QUIT
Begin DoDot:1
+6 SET O=0
SET ANSMR=M
+7 FOR
SET O=$ORDER(^ANSR(ANSADM,"AT",M,O))
IF O=""
QUIT
IF $DATA(^ANSR(O,0))
Begin DoDot:2
+8 IF $PIECE(^ANSR(O,0),U,5)="D"
SET A=0
QUIT
+9 SET N=O
End DoDot:2
End DoDot:1
+10 SET (ANSCL,ANSAF,ANSDX)=""
+11 IF ANSDA
SET N=ANSDA
+12 IF $ORDER(^ANSR(ANSADM,"AT",X))=""
SET ANSDX=$GET(^ANSR(ANSADM,"DX"))
IF $PIECE(ANSDX,U,2)'=ANSUN
SET ANSDX=$PIECE(ANSDX,U)
+13 IF 'N
QUIT
+14 SET M=0
+15 FOR
SET M=$ORDER(^ANSR(N,"L",M))
IF M<1
QUIT
Begin DoDot:1
+16 SET $PIECE(ANSCL,U,M)=$PIECE($GET(^ANSR(N,"L",M,0)),U,2)
End DoDot:1
+17 SET M=0
+18 FOR
SET M=$ORDER(^ANSR(N,"F",M))
IF M=""
QUIT
Begin DoDot:1
+19 IF $DATA(^ANSR(N,"F",M,0))
SET ANSAF=$GET(ANSAF)_M_U
End DoDot:1
+20 QUIT
HEAD DO ^ANSMENU
+1 SET ANSX="PATIENT ACUITY ASSESSMENT"
+2 WRITE !!,?80-$LENGTH(ANSX)/2,ANSX
+3 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 QUIT
2 ;;1^DAY;;2^NIGHT
3 ;;1^DAY;;2^EVENING;;3^NIGHT
