- 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
