source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN55.m@ 623

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1YSCEN55 ;ALB/ASF-CENSUS HX DATE SORT ;12/19/90 09:19 ;03/14/94 15:13
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4EN2 ; Called from MENU option YSCENDAYHX
5 ;
6 D IN S %DT("A")="Most recent date :",%DT="APXE" D ^%DT S YSTO=+Y,YSTO1=+Y Q:Y<1 S YSTO=9999999-YSTO-1
7 S %DT("A")="To oldest date: ",%DT="APXE" D ^%DT S YSFRM=+Y,YSFRM1=+Y Q:Y<1 S YSFRM=9999999-YSFRM-.0001
8 S:YSFRM'>YSTO X=YSFRM,YSFRM=YSTO,YSTO=X
9ASK ;
10 S (YSFL6,YSFL5)=0 R !,"Do you wish to output a single Ward? N// ",YSFL7:DTIME S YSTOUT='$T,YSUOUT=YSFL7["^" Q:YSTOUT!(YSUOUT)
11 S YSR1="YSFL7",YSR2="N",YSR3="YN",YSR4="Answer Yes if you want to restrict listing to a particular ward" D ^YSCEN14 G ASK:YSFL7="?" Q:YSFL7=-1
12 ;
13 ; Undefined Q3 error occurs if user ^'s at 'ward' query
14 ; Thanks to Chris Parris, Birmingham ISC, for reporting problem!!!
15 I "Yy"[YSFL7 K Q3 S YSFL6=1 D A^YSCEN51 Q:$G(Q3)!('$D(Q3)) ;->
16 ;
17 K IOP S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") S ZTRTN="HXQ^YSCEN55",ZTDESC="YS IP HX" F ZZ="YS(","YSTO","YSTO1","YSFL6","YSFL5","W1","YSFRM","YSFRM1" S ZTSAVE(ZZ)=""
18 I D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) Q
19HXQ ;
20 U IO S YSTLT="INPATIENT HISTORY: ",Y=YSTO1 D DD^%DT S YSTLT=YSTLT_Y,Y=YSFRM1 D DD^%DT S YSTLT=YSTLT_"-"_Y
21 K Y D ENDTM^YSUTL S YSHTM=YSTM,YSTLT=YSTLT_" "_YSDT(0)_" "_YSHTM_" pg.",P=0
22 S X7=YSTO,Q3=0 D HDD F S X7=$O(^YSG("INP","AIN",X7)) Q:'X7!(X7>YSFRM) D 3 Q:Q3
23 G END
243 ;
25 Q:Q3 S W1=0 F S W1=$O(^YSG("INP","AIN",X7,W1)) Q:'W1 S YSDFN=$P(^YSG("INP",W1,0),U,2),DA=W1 D 1^YSCEN51:YSFL6,2^YSCEN5:'YSFL6!(YSFL5) D:$Y+8>IOSL WAIT,HDD Q:Q3
26 Q
27WAIT ;
28 Q:Q3 D:IOST?1"C-".E WAIT^YSCEN1 Q
29HDD ;
30 Q:Q3 S P=P+1 W @IOF,YSTLT,P Q:'YSFL6 W !,"Listing for the following Teams: " S X=0 F S X=$O(YS(X)) Q:'X S X1=$P(^YSG("SUB",X,0),U) W:$L(X1)>IOM ! W ?$X+1,X1,","
31 W ! Q
32END ;
33 D KILL^%ZTLOAD
34 K ^UTILITY($J),%ZIS,IOP,YSFL5,YSFL7 W !! D ^%ZISC Q
35IN ;
36 S YSTLT="M E N T A L H E A L T H I N P A T I E N T H I S T O R Y" W @IOF,!?((IOM-$L(YSTLT))\2),YSTLT,!
37 Q
Note: See TracBrowser for help on using the repository browser.