- 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
