- 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
