Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURCAS0

NURCAS0.m

Go to the documentation of this file.
  1. 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
  1. ;MODIFIED BY MD;01/19/87
  1. Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=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
  1. I NURSCH'=+NURSCH!(NURSCH<1)!(NURSCH>2) W !,$C(7),"ANSWER WITH NUMBER 1 OR 2",! G NURCAS0
  1. S:NURSCH=1 NURBRSW=1
  1. W ! K NACT D WARDPAT^NURCUT0 G:NURQUIT QUIT
  1. D EN6^NURSUT0 G:NURQUIT QUIT
  1. W ! S ZTDESC="Nursing Patient Census/Assignment Worksheet",ZTRTN="START^NURCAS0" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
  1. START ;
  1. D NOW^%DTC S NURDT=% K %,%H I $E(IOST)="P",NCOPY>1 F NURI=1:1 Q:NURI'<NCOPY D REPORT
  1. E D REPORT
  1. QUIT ; KILL LOCAL VARIABLES
  1. K ^TMP($J,"NURCEN") D CLOSE^NURSUT1,KVAR^VADPT,^NURCKILL
  1. Q
  1. REPORT U IO S (ISW(1),NURSW1,NURPAGE)=0 K ^TMP($J,"NURCEN"),^TMP("DIQ1",$J)
  1. D ^NURCAS2
  1. I '$D(^TMP($J,"NURCEN")) D HEADER W $C(7),!,"NO PATIENTS IN SELECTED ROOM(S) ON "_NPWARD Q
  1. PRINT ;PRINT ROUTINE
  1. S NBED="" F S NBED=$O(^TMP($J,"NURCEN",NBED)) Q:NBED=""!(NURQUIT) D NN
  1. Q
  1. NN S NBED(0)="" F S NBED(0)=$O(^TMP($J,"NURCEN",NBED,NBED(0))) Q:NBED(0)=""!(NURQUIT) D NO
  1. Q
  1. NO D:'NURSW1 HEADER S N1="" F S N1=$O(^TMP($J,"NURCEN",NBED,NBED(0),N1)) Q:N1=""!(NURQUIT) D PRINT1
  1. Q
  1. PRINT1 S NDATA=$G(^TMP($J,"NURCEN",NBED,NBED(0),N1)),DFN=$P(NDATA,"^"),SSN=$P(NDATA,"^",2) D ^NURSAPCH
  1. D EN6^NURSCUTL S NURSCLAS("CL")=1 D EN2^NURSCUTL
  1. 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:"")
  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),"^"))
  1. I ($Y>(IOSL-14)) D HEADER Q:NURQUIT
  1. D HEADER1 I 'NURBRSW D ^NURCAS1 Q:NURQUIT W !!
  1. I ($Y>(IOSL-8)) D HEADER Q:NURQUIT D HEADER1
  1. W !,?2,"ADL",?7,"SAFETY",?15,"BATH",?22,"DIET",?30,"BP",?37,"TPR",?44,"WT",?50,"TREATMENTS",?63,"I/O",?71,"OTHER",!,NURX,!
  1. F X=1:1:4 D HEADER2
  1. W NURX,!
  1. Q
  1. I $E(IOST)="C",NURSW1 D ENDPG^NURSUT1 S NURQUIT=$G(NUROUT) Q:NURQUIT
  1. 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
  1. W !,"UNIT: ",NPWARD,!,"TOUR: ",$E(NURX,1,10),!,"STAFF:" F X=1:1:5 W ?$X+2,$E(NURX,1,12)
  1. W !,NURX
  1. Q
  1. HEADER1 ;
  1. S VAINDT=NURDT D INP^VADPT W !,"RM/BED: ",$S($D(VAIN(5)):VAIN(5),1:""),?26,"BEDSECTION: ",NSEC,?45,"ADM: ",$P(NDATA,"^",3)
  1. K NURSAL,NURSALGR D ALLERGY^NURCUT1(DFN,.NURSAL)
  1. S (NURSJ,X)=1,NURSALGR(1)="REACTIONS: " F NURSI=0:0 S NURSI=$O(NURSAL(NURSI)) Q:NURSI'>0 D
  1. . I $L(NURSALGR(X))+$L(NURSAL(NURSI))+2>IOM S NURSJ=1,NURSALGR(X)=NURSALGR(X)_",",X=X+1,NURSALGR(X)=" "
  1. . S NURSALGR(X)=NURSALGR(X)_$S(NURSJ>1:", ",1:"")_$P(NURSAL(NURSI),U),NURSJ=NURSJ+1
  1. . Q
  1. 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)
  1. W !,"CATEGORY: ",$S($D(NURCAT):NURCAT,1:"") W ?26,"FACTORS: (" W:$D(NURFACT) NURFACT W ")" I $D(NCOM),NCOM'="" W !,"COMMENTS: ",?22,NCOM
  1. W !,"ADMITTING DIAGNOSIS: ",?22,"ON FILE"
  1. F I=0:0 S I=$O(NURSALGR(I)) Q:I'>0 W !,NURSALGR(I)
  1. Q
  1. HEADER2 W ?6,"|",?13,"|",?20,"|",?27,"|",?34,"|",?41,"|",?48,"|",?60,"|",?67,"|",?79,"|",!
  1. Q