NURCAS0 ;HIRMFO/RM,MD,RTK,FT-PATIENT CENSUS/ASSIGNMENT WORKSHEET WARD ;5/16/17
;;4.0;NURSING SERVICE;**45**;May 9, 2017;Build 12
;MODIFIED BY MD;01/19/87
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
S (NURBRSW,NURQUIT)=0 W !,"Do you want to:",!?5,"1. Print Brief Assignment Worksheet(s)",!?5,"2. Print Complete Assignment Worksheet(s)",!,"Select 1 or 2: " R NURSCH:DTIME I "^"[NURSCH!('$T) S NURQUIT=1 G QUIT
I NURSCH'=+NURSCH!(NURSCH<1)!(NURSCH>2) W !,$C(7),"ANSWER WITH NUMBER 1 OR 2",! G NURCAS0
S:NURSCH=1 NURBRSW=1
W ! K NACT D WARDPAT^NURCUT0 G:NURQUIT QUIT
D EN6^NURSUT0 G:NURQUIT QUIT
W ! S ZTDESC="Nursing Patient Census/Assignment Worksheet",ZTRTN="START^NURCAS0" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
START ;
D NOW^%DTC S NURDT=% K %,%H I $E(IOST)="P",NCOPY>1 F NURI=1:1 Q:NURI'<NCOPY D REPORT
E D REPORT
QUIT ; KILL LOCAL VARIABLES
K ^TMP($J,"NURCEN") D CLOSE^NURSUT1,KVAR^VADPT,^NURCKILL
Q
REPORT U IO S (ISW(1),NURSW1,NURPAGE)=0 K ^TMP($J,"NURCEN"),^TMP("DIQ1",$J)
D ^NURCAS2
I '$D(^TMP($J,"NURCEN")) D HEADER W $C(7),!,"NO PATIENTS IN SELECTED ROOM(S) ON "_NPWARD Q
PRINT ;PRINT ROUTINE
S NBED="" F S NBED=$O(^TMP($J,"NURCEN",NBED)) Q:NBED=""!(NURQUIT) D NN
Q
NN S NBED(0)="" F S NBED(0)=$O(^TMP($J,"NURCEN",NBED,NBED(0))) Q:NBED(0)=""!(NURQUIT) D NO
Q
NO D:'NURSW1 HEADER S N1="" F S N1=$O(^TMP($J,"NURCEN",NBED,NBED(0),N1)) Q:N1=""!(NURQUIT) D PRINT1
Q
PRINT1 S NDATA=$G(^TMP($J,"NURCEN",NBED,NBED(0),N1)),DFN=$P(NDATA,"^"),SSN=$P(NDATA,"^",2) D ^NURSAPCH
D EN6^NURSCUTL S NURSCLAS("CL")=1 D EN2^NURSCUTL
I NURSCLAS S NDATA(1)=$S($D(^NURSA(214.6,NURSCLAS,0)):^(0),1:"") S NURFACT=$S($P(NDATA(1),"^",4)'="":$P(NDATA(1),"^",4),1:""),NURCAT=$S(+$P(NDATA(1),"^",3):$P(NDATA(1),"^",3),1:""),NCOM=$S($P(NDATA(1),"^",7)'="":$P(NDATA(1),"^",7),1:"")
I $D(^NURSF(214,DFN,0)) S NDATA(2)=^(0),NSEC=$S('$D(NDATA(2)):"",'$P(NDATA(2),"^",4):"",'$D(^NURSF(213.3,$P(NDATA(2),"^",4),0)):"",1:$P(^NURSF(213.3,$P(NDATA(2),"^",4),1),"^"))
I ($Y>(IOSL-14)) D HEADER Q:NURQUIT
D HEADER1 I 'NURBRSW D ^NURCAS1 Q:NURQUIT W !!
I ($Y>(IOSL-8)) D HEADER Q:NURQUIT D HEADER1
W !,?2,"ADL",?7,"SAFETY",?15,"BATH",?22,"DIET",?30,"BP",?37,"TPR",?44,"WT",?50,"TREATMENTS",?63,"I/O",?71,"OTHER",!,NURX,!
F X=1:1:4 D HEADER2
W NURX,!
Q
I $E(IOST)="C",NURSW1 D ENDPG^NURSUT1 S NURQUIT=$G(NUROUT) Q:NURQUIT
S NURPAGE=NURPAGE+1,$P(NURX,"-",81)="",NURSW1=1,Y=DT D:+Y D^DIQ W @IOF,!,Y,?25,"PATIENT CARE ASSIGNMENT/WORKSHEET",?70,"PAGE: ",NURPAGE
W !,"UNIT: ",NPWARD,!,"TOUR: ",$E(NURX,1,10),!,"STAFF:" F X=1:1:5 W ?$X+2,$E(NURX,1,12)
W !,NURX
Q
S VAINDT=NURDT D INP^VADPT W !,"RM/BED: ",$S($D(VAIN(5)):VAIN(5),1:""),?26,"BEDSECTION: ",NSEC,?45,"ADM: ",$P(NDATA,"^",3)
K NURSAL,NURSALGR D ALLERGY^NURCUT1(DFN,.NURSAL)
S (NURSJ,X)=1,NURSALGR(1)="REACTIONS: " F NURSI=0:0 S NURSI=$O(NURSAL(NURSI)) Q:NURSI'>0 D
. I $L(NURSALGR(X))+$L(NURSAL(NURSI))+2>IOM S NURSJ=1,NURSALGR(X)=NURSALGR(X)_",",X=X+1,NURSALGR(X)=" "
. S NURSALGR(X)=NURSALGR(X)_$S(NURSJ>1:", ",1:"")_$P(NURSAL(NURSI),U),NURSJ=NURSJ+1
. Q
W !,"NAME: ",$S(N1'=" BLANK":$E(N1,1,19),1:""),?26,"SSN: ",$E($TR(SSN,"-"),6,9),?45,"PHYSICIAN: ",$E($P(VAIN(2),"^",2),1,25)
W !,"CATEGORY: ",$S($D(NURCAT):NURCAT,1:"") W ?26,"FACTORS: (" W:$D(NURFACT) NURFACT W ")" I $D(NCOM),NCOM'="" W !,"COMMENTS: ",?22,NCOM
W !,"ADMITTING DIAGNOSIS: ",?22,"ON FILE"
F I=0:0 S I=$O(NURSALGR(I)) Q:I'>0 W !,NURSALGR(I)
Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCAS0 3626 printed Dec 13, 2024@02:20:07 Page 2
NURCAS0 ;HIRMFO/RM,MD,RTK,FT-PATIENT CENSUS/ASSIGNMENT WORKSHEET WARD ;5/16/17
+1 ;;4.0;NURSING SERVICE;**45**;May 9, 2017;Build 12
+2 ;MODIFIED BY MD;01/19/87
+3 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+4 SET (NURBRSW,NURQUIT)=0
WRITE !,"Do you want to:",!?5,"1. Print Brief Assignment Worksheet(s)",!?5,"2. Print Complete Assignment Worksheet(s)",!,"Select 1 or 2: "
READ NURSCH:DTIME
IF "^"[NURSCH!('$TEST)
SET NURQUIT=1
GOTO QUIT
+5 IF NURSCH'=+NURSCH!(NURSCH<1)!(NURSCH>2)
WRITE !,$CHAR(7),"ANSWER WITH NUMBER 1 OR 2",!
GOTO NURCAS0
+6 if NURSCH=1
SET NURBRSW=1
+7 WRITE !
KILL NACT
DO WARDPAT^NURCUT0
if NURQUIT
GOTO QUIT
+8 DO EN6^NURSUT0
if NURQUIT
GOTO QUIT
+9 WRITE !
SET ZTDESC="Nursing Patient Census/Assignment Worksheet"
SET ZTRTN="START^NURCAS0"
DO EN7^NURSUT0
if POP!($DATA(ZTSK))
GOTO QUIT
START ;
+1 DO NOW^%DTC
SET NURDT=%
KILL %,%H
IF $EXTRACT(IOST)="P"
IF NCOPY>1
FOR NURI=1:1
if NURI'<NCOPY
QUIT
DO REPORT
+2 IF '$TEST
DO REPORT
QUIT ; KILL LOCAL VARIABLES
+1 KILL ^TMP($JOB,"NURCEN")
DO CLOSE^NURSUT1
DO KVAR^VADPT
DO ^NURCKILL
+2 QUIT
REPORT USE IO
SET (ISW(1),NURSW1,NURPAGE)=0
KILL ^TMP($JOB,"NURCEN"),^TMP("DIQ1",$JOB)
+1 DO ^NURCAS2
+2 IF '$DATA(^TMP($JOB,"NURCEN"))
DO HEADER
WRITE $CHAR(7),!,"NO PATIENTS IN SELECTED ROOM(S) ON "_NPWARD
QUIT
PRINT ;PRINT ROUTINE
+1 SET NBED=""
FOR
SET NBED=$ORDER(^TMP($JOB,"NURCEN",NBED))
if NBED=""!(NURQUIT)
QUIT
DO NN
+2 QUIT
NN SET NBED(0)=""
FOR
SET NBED(0)=$ORDER(^TMP($JOB,"NURCEN",NBED,NBED(0)))
if NBED(0)=""!(NURQUIT)
QUIT
DO NO
+1 QUIT
NO if 'NURSW1
DO HEADER
SET N1=""
FOR
SET N1=$ORDER(^TMP($JOB,"NURCEN",NBED,NBED(0),N1))
if N1=""!(NURQUIT)
QUIT
DO PRINT1
+1 QUIT
PRINT1 SET NDATA=$GET(^TMP($JOB,"NURCEN",NBED,NBED(0),N1))
SET DFN=$PIECE(NDATA,"^")
SET SSN=$PIECE(NDATA,"^",2)
DO ^NURSAPCH
+1 DO EN6^NURSCUTL
SET NURSCLAS("CL")=1
DO EN2^NURSCUTL
+2 IF NURSCLAS
SET NDATA(1)=$SELECT($DATA(^NURSA(214.6,NURSCLAS,0)):^(0),1:"")
SET NURFACT=$SELECT($PIECE(NDATA(1),"^",4)'="":$PIECE(NDATA(1),"^",4),1:"")
SET NURCAT=$SELECT(+$PIECE(NDATA(1),"^",3):$PIECE(NDATA(1),"^",3),1:"")
SET NCOM=$SELECT($PIECE(NDATA(1),"^",7)'="":$PIECE(NDATA(1),"^",7),1:"")
+3 IF $DATA(^NURSF(214,DFN,0))
SET NDATA(2)=^(0)
SET NSEC=$SELECT('$DATA(NDATA(2)):"",'$PIECE(NDATA(2),"^",4):"",'$DATA(^NURSF(213.3,$PIECE(NDATA(2),"^",4),0)):"",1:$PIECE(^NURSF(213.3,$PIECE(NDATA(2),"^",4),1),"^"))
+4 IF ($Y>(IOSL-14))
DO HEADER
if NURQUIT
QUIT
+5 DO HEADER1
IF 'NURBRSW
DO ^NURCAS1
if NURQUIT
QUIT
WRITE !!
+6 IF ($Y>(IOSL-8))
DO HEADER
if NURQUIT
QUIT
DO HEADER1
+7 WRITE !,?2,"ADL",?7,"SAFETY",?15,"BATH",?22,"DIET",?30,"BP",?37,"TPR",?44,"WT",?50,"TREATMENTS",?63,"I/O",?71,"OTHER",!,NURX,!
+8 FOR X=1:1:4
DO HEADER2
+9 WRITE NURX,!
+10 QUIT
+1 IF $EXTRACT(IOST)="C"
IF NURSW1
DO ENDPG^NURSUT1
SET NURQUIT=$GET(NUROUT)
if NURQUIT
QUIT
+2 SET NURPAGE=NURPAGE+1
SET $PIECE(NURX,"-",81)=""
SET NURSW1=1
SET Y=DT
if +Y
DO D^DIQ
WRITE @IOF,!,Y,?25,"PATIENT CARE ASSIGNMENT/WORKSHEET",?70,"PAGE: ",NURPAGE
+3 WRITE !,"UNIT: ",NPWARD,!,"TOUR: ",$EXTRACT(NURX,1,10),!,"STAFF:"
FOR X=1:1:5
WRITE ?$X+2,$EXTRACT(NURX,1,12)
+4 WRITE !,NURX
+5 QUIT
+1 SET VAINDT=NURDT
DO INP^VADPT
WRITE !,"RM/BED: ",$SELECT($DATA(VAIN(5)):VAIN(5),1:""),?26,"BEDSECTION: ",NSEC,?45,"ADM: ",$PIECE(NDATA,"^",3)
+2 KILL NURSAL,NURSALGR
DO ALLERGY^NURCUT1(DFN,.NURSAL)
+3 SET (NURSJ,X)=1
SET NURSALGR(1)="REACTIONS: "
FOR NURSI=0:0
SET NURSI=$ORDER(NURSAL(NURSI))
if NURSI'>0
QUIT
Begin DoDot:1
+4 IF $LENGTH(NURSALGR(X))+$LENGTH(NURSAL(NURSI))+2>IOM
SET NURSJ=1
SET NURSALGR(X)=NURSALGR(X)_","
SET X=X+1
SET NURSALGR(X)=" "
+5 SET NURSALGR(X)=NURSALGR(X)_$SELECT(NURSJ>1:", ",1:"")_$PIECE(NURSAL(NURSI),U)
SET NURSJ=NURSJ+1
+6 QUIT
End DoDot:1
+7 WRITE !,"NAME: ",$SELECT(N1'=" BLANK":$EXTRACT(N1,1,19),1:""),?26,"SSN: ",$EXTRACT($TRANSLATE(SSN,"-"),6,9),?45,"PHYSICIAN: ",$EXTRACT($PIECE(VAIN(2),"^",2),1,25)
+8 WRITE !,"CATEGORY: ",$SELECT($DATA(NURCAT):NURCAT,1:"")
WRITE ?26,"FACTORS: ("
if $DATA(NURFACT)
WRITE NURFACT
WRITE ")"
IF $DATA(NCOM)
IF NCOM'=""
WRITE !,"COMMENTS: ",?22,NCOM
+9 WRITE !,"ADMITTING DIAGNOSIS: ",?22,"ON FILE"
+10 FOR I=0:0
SET I=$ORDER(NURSALGR(I))
if I'>0
QUIT
WRITE !,NURSALGR(I)
+11 QUIT
+1 QUIT
