VistA-WorldVistAEHR/r/NURSING_SERVICE-NUR/NURCAS0.m

59 lines
3.5 KiB
Mathematica

NURCAS0 ;HIRMFO/RM,MD,RTK,FT-PATIENT CENSUS/ASSIGNMENT WORKSHEET WARD ;8/9/96 11:44
;;4.0;NURSING SERVICE;;Apr 25, 1997
;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
HEADER ; PRINTING OF HEADING ROUTINE
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
HEADER1 ;
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: ",SSN,?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: "
W ?22,VAIN(9)
F I=0:0 S I=$O(NURSALGR(I)) Q:I'>0 W !,NURSALGR(I)
Q
HEADER2 W ?6,"|",?13,"|",?20,"|",?27,"|",?34,"|",?41,"|",?48,"|",?60,"|",?67,"|",?79,"|",!
Q