source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURCAS0.m@ 1397

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