source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPHYR.m@ 1154

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

initial load of WorldVistAEHR

File size: 839 bytes
RevLine 
[613]1YSPHYR ;SLC/RWF,SLC/DKG,SLC/TGA-PRINT PHYSICAL EXAM ; 3/3/89 08:57 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 ; Called by routine YSPHY
5 U IO S YSX="^YTX(2,1,",YSFHDR="Physical Examination",YSFTR="SF 506" D EN1^YSPROSE G:YSLFT END
6 S YSX="^MR(YSDFN,YSPE,YSIDT,20," I $D(@(YSX_"1,0)")) D EN1^YSPROSE G:YSLFT END
7 S YSX="^MR(YSDFN,YSPE,YSIDT,19," I $D(@(YSX_"1,0)")) D:$Y+4>YSPPL H G:YSLFT END W !!,"Comments:",! D EN1^YSPROSE G:YSLFT END
8 D:$Y+4>YSPPL H G:YSLFT END W !!!! S X=$P(^MR(YSDFN,"PE",YSIDT,0),U,10) D PSIG^YSUTL W Y
9END ;
10 D ENFT^YSFORM:YST D ^%ZISC,KILL^%ZTLOAD G END^YSPHY1
11H ;
12 S:YST YSCON=1 D ENFT^YSFORM:YST,WAIT:'YST Q:YSLFT D:YST ENHD^YSFORM Q
13WAIT ;
14 Q:$E(IOST,1,2)["P-"
15 F I0=1:1:IOSL-$Y-2 W !
16 W:$Y+1<IOSL !
17 N DTOUT,DUOUT,DIRUT
18 S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DUOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT) W @IOF
19 Q
Note: See TracBrowser for help on using the repository browser.