source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURCAS0.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1NURCAS0 ;HIRMFO/RM,MD,RTK,FT-PATIENT CENSUS/ASSIGNMENT WORKSHEET WARD ;8/9/96 11:44
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3 ;MODIFIED BY MD;01/19/87
4 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
5 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
6 I NURSCH'=+NURSCH!(NURSCH<1)!(NURSCH>2) W !,$C(7),"ANSWER WITH NUMBER 1 OR 2",! G NURCAS0
7 S:NURSCH=1 NURBRSW=1
8 W ! K NACT D WARDPAT^NURCUT0 G:NURQUIT QUIT
9 D EN6^NURSUT0 G:NURQUIT QUIT
10 W ! S ZTDESC="Nursing Patient Census/Assignment Worksheet",ZTRTN="START^NURCAS0" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
11START ;
12 D NOW^%DTC S NURDT=% K %,%H I $E(IOST)="P",NCOPY>1 F NURI=1:1 Q:NURI'<NCOPY D REPORT
13 E D REPORT
14QUIT ; KILL LOCAL VARIABLES
15 K ^TMP($J,"NURCEN") D CLOSE^NURSUT1,KVAR^VADPT,^NURCKILL
16 Q
17REPORT U IO S (ISW(1),NURSW1,NURPAGE)=0 K ^TMP($J,"NURCEN"),^TMP("DIQ1",$J)
18 D ^NURCAS2
19 I '$D(^TMP($J,"NURCEN")) D HEADER W $C(7),!,"NO PATIENTS IN SELECTED ROOM(S) ON "_NPWARD Q
20PRINT ;PRINT ROUTINE
21 S NBED="" F S NBED=$O(^TMP($J,"NURCEN",NBED)) Q:NBED=""!(NURQUIT) D NN
22 Q
23NN S NBED(0)="" F S NBED(0)=$O(^TMP($J,"NURCEN",NBED,NBED(0))) Q:NBED(0)=""!(NURQUIT) D NO
24 Q
25NO D:'NURSW1 HEADER S N1="" F S N1=$O(^TMP($J,"NURCEN",NBED,NBED(0),N1)) Q:N1=""!(NURQUIT) D PRINT1
26 Q
27PRINT1 S NDATA=$G(^TMP($J,"NURCEN",NBED,NBED(0),N1)),DFN=$P(NDATA,"^"),SSN=$P(NDATA,"^",2) D ^NURSAPCH
28 D EN6^NURSCUTL S NURSCLAS("CL")=1 D EN2^NURSCUTL
29 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:"")
30 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),"^"))
31 I ($Y>(IOSL-14)) D HEADER Q:NURQUIT
32 D HEADER1 I 'NURBRSW D ^NURCAS1 Q:NURQUIT W !!
33 I ($Y>(IOSL-8)) D HEADER Q:NURQUIT D HEADER1
34 W !,?2,"ADL",?7,"SAFETY",?15,"BATH",?22,"DIET",?30,"BP",?37,"TPR",?44,"WT",?50,"TREATMENTS",?63,"I/O",?71,"OTHER",!,NURX,!
35 F X=1:1:4 D HEADER2
36 W NURX,!
37 Q
38HEADER ; PRINTING OF HEADING ROUTINE
39 I $E(IOST)="C",NURSW1 D ENDPG^NURSUT1 S NURQUIT=$G(NUROUT) Q:NURQUIT
40 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
41 W !,"UNIT: ",NPWARD,!,"TOUR: ",$E(NURX,1,10),!,"STAFF:" F X=1:1:5 W ?$X+2,$E(NURX,1,12)
42 W !,NURX
43 Q
44HEADER1 ;
45 S VAINDT=NURDT D INP^VADPT W !,"RM/BED: ",$S($D(VAIN(5)):VAIN(5),1:""),?26,"BEDSECTION: ",NSEC,?45,"ADM: ",$P(NDATA,"^",3)
46 K NURSAL,NURSALGR D ALLERGY^NURCUT1(DFN,.NURSAL)
47 S (NURSJ,X)=1,NURSALGR(1)="REACTIONS: " F NURSI=0:0 S NURSI=$O(NURSAL(NURSI)) Q:NURSI'>0 D
48 . I $L(NURSALGR(X))+$L(NURSAL(NURSI))+2>IOM S NURSJ=1,NURSALGR(X)=NURSALGR(X)_",",X=X+1,NURSALGR(X)=" "
49 . S NURSALGR(X)=NURSALGR(X)_$S(NURSJ>1:", ",1:"")_$P(NURSAL(NURSI),U),NURSJ=NURSJ+1
50 . Q
51 W !,"NAME: ",$S(N1'=" BLANK":$E(N1,1,19),1:""),?26,"SSN: ",SSN,?45,"PHYSICIAN: ",$E($P(VAIN(2),"^",2),1,25)
52 W !,"CATEGORY: ",$S($D(NURCAT):NURCAT,1:"") W ?26,"FACTORS: (" W:$D(NURFACT) NURFACT W ")" I $D(NCOM),NCOM'="" W !,"COMMENTS: ",?22,NCOM
53 W !,"ADMITTING DIAGNOSIS: "
54 W ?22,VAIN(9)
55 F I=0:0 S I=$O(NURSALGR(I)) Q:I'>0 W !,NURSALGR(I)
56 Q
57HEADER2 W ?6,"|",?13,"|",?20,"|",?27,"|",?34,"|",?41,"|",?48,"|",?60,"|",?67,"|",?79,"|",!
58 Q
Note: See TracBrowser for help on using the repository browser.