source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURCHSUM.m@ 1318

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1NURCHSUM ;HIRMFO/YH,RM-HEALTH SUMMARY REPORT BY NUR WARD/ROOM/PT ;3/29/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ;PATIENT HEALTH SUMMARY REPORT BY WARD/ROOM/PT
4 S X="GMTSDVR" X ^%ZOSF("TEST") I '$T W !,"YOU NEED HEALTH SUMMARY VERSION 2.5 TO RUN THIS REPORT",! G Q
5 K GMTYP D SELTYP^GMTSDVR G:'+$G(GMTYP(1)) Q
6 S NACT=0 D ^NURCUT0 G:NURQUIT Q D HSUM
7Q K NACT,NN,DFN,NURQUIT,NPWARD,NURMBD,NULL,NUREDB,NURWARD D ^%ZISC D KILL2
8 Q
9HSUM ;CALL HEALTH SUMMARY PACKAGE FOR REPORT
10 K ZTSK,IOP,%ZIS S %ZIS="PQ" D ^%ZIS Q:POP
11 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
12START ;
13 I "Pp"[NUREDB Q:DFN'>0 D ENX^GMTSDVR(DFN,+GMTYP(1)) Q
14 F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",NURWARD,DFN)) Q:DFN'>0!($D(DIROUT)) D WARDPT
15 I '$D(NURPT) W !,"No patients for this report",! Q
16 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)
17 Q
18WARDPT ;
19 D PT Q:"Ss"[NUREDB&($S(NURBED="":1,1:'$D(NRMBD(NURBED))))!(NURNAM="")
20 S NRM="BLANK",NBD="BLANK" S:NURBED'="" NRM=$P(NURBED,"-"),NBD=$P(NURBED,"-",2) S NURPT(NRM,NBD,DFN)="" Q
21 Q
22LOOP ;
23 F X="NURQUIT","NRMBD(","NPWARD","NUREDB","DFN","NURWARD","GMT*","ENTRY" S ZTSAVE(X)=""
24 Q
25STOP ;
26 W !,"Press return to display data for the next patient or ""^"" to stop " R X:DTIME
27 I '$T!(X="^") S DIROUT=1 Q
28 Q
29KILL ;
30 K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D KILL2 Q
31KILL2 ;
32 K GMW,GMX,GMTSEG,GMTSEGC,GMTSEGI,GMTSTITL,GMTYP,NRMBD,NRM,NURBED,NURNAM,NURPT,NBD Q
33PT ;
34 D 1^VADPT S NURBED=$P($P(VAIN(5),"^"),"-",1,2),NURNAM=$P(VADM(1),"^") D KVAR^VADPT Q
Note: See TracBrowser for help on using the repository browser.