- 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 Feb 18, 2025@23:46:32 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