- 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
