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

NURCHSUM.m

Go to the documentation of this file.
  1. NURCHSUM ;HIRMFO/YH,RM-HEALTH SUMMARY REPORT BY NUR WARD/ROOM/PT ;3/29/96
  1. ;;4.0;NURSING SERVICE;;Apr 25, 1997
  1. EN1 ;PATIENT HEALTH SUMMARY REPORT BY WARD/ROOM/PT
  1. S X="GMTSDVR" X ^%ZOSF("TEST") I '$T W !,"YOU NEED HEALTH SUMMARY VERSION 2.5 TO RUN THIS REPORT",! G Q
  1. K GMTYP D SELTYP^GMTSDVR G:'+$G(GMTYP(1)) Q
  1. S NACT=0 D ^NURCUT0 G:NURQUIT Q D HSUM
  1. Q K NACT,NN,DFN,NURQUIT,NPWARD,NURMBD,NULL,NUREDB,NURWARD D ^%ZISC D KILL2
  1. Q
  1. HSUM ;CALL HEALTH SUMMARY PACKAGE FOR REPORT
  1. K ZTSK,IOP,%ZIS S %ZIS="PQ" D ^%ZIS Q:POP
  1. I $D(IO("Q")) K IO("Q"),ZTSAVE D LOOP S ZTRTN="START^NURCHSUM",ZTDESC="HEALTH SUMMARY",ZTIO=ION_";"_IOM_";"_IOSL D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!") D KILL,KILL2 Q
  1. START ;
  1. I "Pp"[NUREDB Q:DFN'>0 D ENX^GMTSDVR(DFN,+GMTYP(1)) Q
  1. F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",NURWARD,DFN)) Q:DFN'>0!($D(DIROUT)) D WARDPT
  1. I '$D(NURPT) W !,"No patients for this report",! Q
  1. S NRM="" F S NRM=$O(NURPT(NRM)) Q:NRM=""!($D(DIROUT)) S NBD="" F S NBD=$O(NURPT(NRM,NBD)) Q:NBD=""!($D(DIROUT)) S DFN=0 F S DFN=$O(NURPT(NRM,NBD,DFN)) Q:DFN'>0!($D(DIRPOUT)) D ENX^GMTSDVR(DFN,+GMTYP(1)) D:$E(IOST)="C" STOP Q:$D(DIROUT)
  1. Q
  1. WARDPT ;
  1. D PT Q:"Ss"[NUREDB&($S(NURBED="":1,1:'$D(NRMBD(NURBED))))!(NURNAM="")
  1. S NRM="BLANK",NBD="BLANK" S:NURBED'="" NRM=$P(NURBED,"-"),NBD=$P(NURBED,"-",2) S NURPT(NRM,NBD,DFN)="" Q
  1. Q
  1. LOOP ;
  1. F X="NURQUIT","NRMBD(","NPWARD","NUREDB","DFN","NURWARD","GMT*","ENTRY" S ZTSAVE(X)=""
  1. Q
  1. STOP ;
  1. W !,"Press return to display data for the next patient or ""^"" to stop " R X:DTIME
  1. I '$T!(X="^") S DIROUT=1 Q
  1. Q
  1. KILL ;
  1. K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D KILL2 Q
  1. KILL2 ;
  1. K GMW,GMX,GMTSEG,GMTSEGC,GMTSEGI,GMTSTITL,GMTYP,NRMBD,NRM,NURBED,NURNAM,NURPT,NBD Q
  1. PT ;
  1. D 1^VADPT S NURBED=$P($P(VAIN(5),"^"),"-",1,2),NURNAM=$P(VADM(1),"^") D KVAR^VADPT Q