ANSQRP ;IHE/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 K DTOUT,DUOUT
S ANSU=$S($D(^ANSD(59.1,ANSUNIT,0)):$P(^(0),U),1:""),Y=DT
X ^DD("DD")
S ANSDT=Y,ANSPG=0
S X=$P($H,",",2),H=X\3600,M=X#3600\60,X=$S(X>43199:"PM",1:"AM"),M=$E(100+M,2,3)
S:H>12 H=H-12
S:H<1 H=12
S ANSTM=H_":"_M_" "_X
W:$G(IOST)["C-" @IOF
D HEAD
K A
S (ANSR,ANSPTC)=""
F S ANSR=$O(^TMP("ANS",$J,ANSR)) Q:ANSR=""!$D(DTOUT)!$D(DUOUT) D
.S ANSB=""
.F S ANSB=$O(^TMP("ANS",$J,ANSR,ANSB)) Q:ANSB=""!$D(DTOUT)!$D(DUOUT) D
..S ANSDFN=""
..F S ANSDFN=$O(^TMP("ANS",$J,ANSR,ANSB,ANSDFN)) Q:ANSDFN=""!$D(DTOUT)!$D(DUOUT) S ANSDX=^(ANSDFN),ANSCL=$G(^(ANSDFN,1)),ANSAF=$G(^(2)) D
...S ANSPTC=ANSPTC+1,ANSPL=0
...Q:'$D(^DPT(ANSDFN,0)) S P=$P(^(0),U),N=""
...I $D(^AUPNPAT(ANSDFN,41,ANSSITE,0)) S N="("_$P(^(0),U,2)_")"
...S L=$L(N),P=$E(P,1,28-L)_" "_N,(R,B)="",X=$P(ANSDX,U,3),Y=$P(ANSDX,U,4)
...I X,$D(^ANSD(59.1,ANSUNIT,"R",X,0)) S R=$P(^(0),U) I Y,$D(^("B",Y,0)) S B=$P(^(0),U)
...D PRINT
W !!,"Total Patients: ",ANSPTC,!!
S N=0
F I=1:1 S N=$O(^ANSD(51.1,1,"K",N)) Q:N<1 I $D(^(N,0)) S X=^(0) D
.W ?I-1*18,"Level ",$P(X,U,2),": ",$S($D(A(N)):A(N),1:"None")
D PAUSE^ANSDIC
Q
PRINT D:$Y>54 HEAD
I $Y+4>IOSL D PAUSE^ANSDIC Q:$D(DUOUT)!$D(DTOUT) D HEAD
W !,$J(R,5),$J(B,3),?10,P,?39
F I=1:1:10 S L=$P(ANSCL,U,I),ANSPL=ANSPL+L,P=$S(L>3:"*",1:" ") W " ",$J(P_L,3)
A4 S DX=$P(ANSDX,U)
W !,?5,"Dx: "
I DX="" W "None Listed"
E D
.W:IOST["C-" @ANSRVON
.W DX,@ANSSPAC
.W:IOST["C-" @ANSRVOF
W !," Adj FX: "
S T=0
I ANSAF="" W "None Listed"
I ANSAF]"" D
.F I=1:1 S X=$P(ANSAF,U,I) Q:X="" D:$D(^ANSD(59.3,X,0))
..S X=$P(^ANSD(59.3,X,0),U,2),S=$P(^(0),U,3),L=$L(X)
..W:$X+L>74 !,?14
..W:I>1 ","
..W:IOST["C-" @ANSRVON
..W X_" "
..W:IOST["C-" @ANSRVOF
..I S]"" S @("T=T"_S_"4")
S ANSPL=ANSPL+T-1
S L="",N=$O(^ANSD(51.1,1,"K",ANSPL))
I N,$D(^ANSD(51.1,1,"K",N,0)) S L=^(0)
S NCL1=$P(L,U,2),NCL2=$P(L,U,3)
W !,?4,"NCL: "
I NCL1'["V" W NCL1_" "_NCL2
E D
.W:IOST["C-" @ANSRVON
.W NCL1_" "_NCL2_" "
.W:IOST["C-" @ANSRVOF
S L=+L
S A(L)=$G(A(L))+1
W !
Q
HEAD D HEAD^ANSMENU ;CSC 10-97 D ^ANSMENU
S ANSX="UNIT ROSTER"
W !!,?80-$L(ANSX)/2,ANSX
S ANSPG=ANSPG+1 W ?70,"Page ",ANSPG
W !,?80-$L(ANSU)\2,ANSU,!!,?80-$L(ANSDT)\2,ANSDT,!,?80-$L(ANSTM)\2,ANSTM,!!
W !," Room-Bed",?20,"Patient",?39
F I=1:1:10 S X=$S($D(^ANSD(59,I,0)):$P(^(0),U,3),1:"") W $J(X,4)
W !,"---------",?10,"----------------------------"
W ?39
F I=1:1:10 W " ---"
Q
ANSQRP ;IHE/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 KILL DTOUT,DUOUT
+1 SET ANSU=$SELECT($DATA(^ANSD(59.1,ANSUNIT,0)):$PIECE(^(0),U),1:"")
SET Y=DT
+2 XECUTE ^DD("DD")
+3 SET ANSDT=Y
SET ANSPG=0
+4 SET X=$PIECE($HOROLOG,",",2)
SET H=X\3600
SET M=X#3600\60
SET X=$SELECT(X>43199:"PM",1:"AM")
SET M=$EXTRACT(100+M,2,3)
+5 IF H>12
SET H=H-12
+6 IF H<1
SET H=12
+7 SET ANSTM=H_":"_M_" "_X
+8 IF $GET(IOST)["C-"
WRITE @IOF
+9 DO HEAD
+10 KILL A
+11 SET (ANSR,ANSPTC)=""
+12 FOR
SET ANSR=$ORDER(^TMP("ANS",$JOB,ANSR))
IF ANSR=""!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:1
+13 SET ANSB=""
+14 FOR
SET ANSB=$ORDER(^TMP("ANS",$JOB,ANSR,ANSB))
IF ANSB=""!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:2
+15 SET ANSDFN=""
+16 FOR
SET ANSDFN=$ORDER(^TMP("ANS",$JOB,ANSR,ANSB,ANSDFN))
IF ANSDFN=""!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
SET ANSDX=^(ANSDFN)
SET ANSCL=$GET(^(ANSDFN,1))
SET ANSAF=$GET(^(2))
Begin DoDot:3
+17 SET ANSPTC=ANSPTC+1
SET ANSPL=0
+18 IF '$DATA(^DPT(ANSDFN,0))
QUIT
SET P=$PIECE(^(0),U)
SET N=""
+19 IF $DATA(^AUPNPAT(ANSDFN,41,ANSSITE,0))
SET N="("_$PIECE(^(0),U,2)_")"
+20 SET L=$LENGTH(N)
SET P=$EXTRACT(P,1,28-L)_" "_N
SET (R,B)=""
SET X=$PIECE(ANSDX,U,3)
SET Y=$PIECE(ANSDX,U,4)
+21 IF X
IF $DATA(^ANSD(59.1,ANSUNIT,"R",X,0))
SET R=$PIECE(^(0),U)
IF Y
IF $DATA(^("B",Y,0))
SET B=$PIECE(^(0),U)
+22 DO PRINT
End DoDot:3
End DoDot:2
End DoDot:1
+23 WRITE !!,"Total Patients: ",ANSPTC,!!
+24 SET N=0
+25 FOR I=1:1
SET N=$ORDER(^ANSD(51.1,1,"K",N))
IF N<1
QUIT
IF $DATA(^(N,0))
SET X=^(0)
Begin DoDot:1
+26 WRITE ?I-1*18,"Level ",$PIECE(X,U,2),": ",$SELECT($DATA(A(N)):A(N),1:"None")
End DoDot:1
+27 DO PAUSE^ANSDIC
+28 QUIT
PRINT IF $Y>54
DO HEAD
+1 IF $Y+4>IOSL
DO PAUSE^ANSDIC
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HEAD
+2 WRITE !,$JUSTIFY(R,5),$JUSTIFY(B,3),?10,P,?39
+3 FOR I=1:1:10
SET L=$PIECE(ANSCL,U,I)
SET ANSPL=ANSPL+L
SET P=$SELECT(L>3:"*",1:" ")
WRITE " ",$JUSTIFY(P_L,3)
A4 SET DX=$PIECE(ANSDX,U)
+1 WRITE !,?5,"Dx: "
+2 IF DX=""
WRITE "None Listed"
+3 IF '$TEST
Begin DoDot:1
+4 IF IOST["C-"
WRITE @ANSRVON
+5 WRITE DX,@ANSSPAC
+6 IF IOST["C-"
WRITE @ANSRVOF
End DoDot:1
+7 WRITE !," Adj FX: "
+8 SET T=0
+9 IF ANSAF=""
WRITE "None Listed"
+10 IF ANSAF]""
Begin DoDot:1
+11 FOR I=1:1
SET X=$PIECE(ANSAF,U,I)
IF X=""
QUIT
IF $DATA(^ANSD(59.3,X,0))
Begin DoDot:2
+12 SET X=$PIECE(^ANSD(59.3,X,0),U,2)
SET S=$PIECE(^(0),U,3)
SET L=$LENGTH(X)
+13 IF $X+L>74
WRITE !,?14
+14 IF I>1
WRITE ","
+15 IF IOST["C-"
WRITE @ANSRVON
+16 WRITE X_" "
+17 IF IOST["C-"
WRITE @ANSRVOF
+18 IF S]""
SET @("T=T"_S_"4")
End DoDot:2
End DoDot:1
+19 SET ANSPL=ANSPL+T-1
+20 SET L=""
SET N=$ORDER(^ANSD(51.1,1,"K",ANSPL))
+21 IF N
IF $DATA(^ANSD(51.1,1,"K",N,0))
SET L=^(0)
+22 SET NCL1=$PIECE(L,U,2)
SET NCL2=$PIECE(L,U,3)
+23 WRITE !,?4,"NCL: "
+24 IF NCL1'["V"
WRITE NCL1_" "_NCL2
+25 IF '$TEST
Begin DoDot:1
+26 IF IOST["C-"
WRITE @ANSRVON
+27 WRITE NCL1_" "_NCL2_" "
+28 IF IOST["C-"
WRITE @ANSRVOF
End DoDot:1
+29 SET L=+L
+30 SET A(L)=$GET(A(L))+1
+31 WRITE !
+32 QUIT
HEAD ;CSC 10-97 D ^ANSMENU
DO HEAD^ANSMENU
+1 SET ANSX="UNIT ROSTER"
+2 WRITE !!,?80-$LENGTH(ANSX)/2,ANSX
+3 SET ANSPG=ANSPG+1
WRITE ?70,"Page ",ANSPG
+4 WRITE !,?80-$LENGTH(ANSU)\2,ANSU,!!,?80-$LENGTH(ANSDT)\2,ANSDT,!,?80-$LENGTH(ANSTM)\2,ANSTM,!!
+5 WRITE !," Room-Bed",?20,"Patient",?39
+6 FOR I=1:1:10
SET X=$SELECT($DATA(^ANSD(59,I,0)):$PIECE(^(0),U,3),1:"")
WRITE $JUSTIFY(X,4)
+7 WRITE !,"---------",?10,"----------------------------"
+8 WRITE ?39
+9 FOR I=1:1:10
WRITE " ---"
+10 QUIT
