source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPTXR.m@ 1754

YSPTXR ;SLC/DKG,SLC/TGA-TEXT FILE REPORTS ;5/30/91  09:25 ;
 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
 ;
 ; Called by routine YSPTX
 S YSIDT=9999999-YSYDT I '$D(^PTX(YSDFN,YSTY,YSIDT)) S Y=YSYDT D ENDD^YSUTL W $C(7),!!!?3,"There are no ",YSFHDR,"s on ",Y,! H 1 G FN^YSPTX
 S %ZIS="Q" K IOP D ^%ZIS G:POP END1^YSPTX
 I $D(IO("Q")) S ZTRTN="ENPRINT^YSPTXR",ZTSAVE("YS*")="",ZTDESC="YS TEXT PRINT" D ^%ZTLOAD G END1^YSPTX
ENPRINT ;
 K ^UTILITY($J) S YSMOR=0 D INIT
CP ;
 K YSUSN D FU
CP1 ;
 S YSUS=$O(YSUSN(YSUS)) I YSUS="" G END:'YSMOR Q
 S YSUSER=$P(YSUSN(YSUS),U),YSNT=$P(YSUSN(YSUS),U,3)
 S DIC="^PTX(YSDFN,YSTY,YSIDT,1,YSUSER,1,YSNT,1,"
 S DIWL=1,DIWR=80,DIWF="W",DWI="F D=1:1:DW2 S X="_DIC_"D,0) D:$Y+YSPF>IOSL CK Q:YSLFT  D ^DIWP"
 U IO D DT G:YSLFT END1^YSPTX
 D DIWP G:YSLFT END1^YSPTX D UNM G:YSLFT END1^YSPTX D:$Y+YSPF>IOSL CK G:YSLFT END1^YSPTX W ! G CP1
END ;
 D KILL^%ZTLOAD
 D ENFT^YSFORM:YSP0,WAIT:'YSP0 D ^%ZISC G END1^YSPTX
 ;
FU ; Called by routine YSCEN33
 S YSUS=0
 F  S YSUS=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUS)) Q:'YSUS  S YSNT=0 D
 .F  S YSNT=$O(^PTX(YSDFN,YSTY,YSIDT,1,YSUS,1,YSNT)) Q:'YSNT  S:$D(^PTX(YSDFN,YSTY,YSIDT,1,YSUS,1,YSNT,0)) YSTM=^(0) S:$D(YSUSN(YSTM)) YSTM=YSTM+.00001 S YSUSN(YSTM)=YSUS_U_YSTM_U_YSNT
 Q
UNM ;
 D:$Y+YSPF+$S(YSP0:2,1:0)>IOSL CK Q:YSLFT  S X=YSUSER D PSIG^YSUTL W ! W:YSP0 !! W Y Q
DT ;
 S YSDTM=$P(YSUSN(YSUS),U,2),Y=$P(YSDTM,".") D ENDD^YSUTL S YSYD=$P(YSDTM,".",2),YSMN=$E(YSYD,3,4) S:$L(YSMN)=1 YSMN=YSMN_"0"
 S YSHR=$E(YSYD,1,2),A=$S(YSHR<12:YSHR,YSHR>12:YSHR-12,YSHR=12:12,1:"00"),M=$S(YSHR<12:"A",YSHR>11:"P",1:0),YSTM=A_":"_YSMN_" "_M_"M"
 D:$Y+YSPF+3>IOSL CK Q:YSLFT  W !,YSDT(1)," at ",YSTM Q
DIWP ;
 S Z=DIC_"0)",DW2=$P(@(Z),U,4) D:$Y+YSPF+1>IOSL CK Q:YSLFT  W !! X DWI D ^DIWW Q
 ;
CK S:YSP0 YSCON=1 D ENFT^YSFORM:YSP0,WAIT:'YSP0 Q:YSLFT  D:YSP0 ENHD^YSFORM Q
WAIT ;
 F I0=1:1:IOSL-$Y-4 W !
 N DTOUT,DUOUT,DIRUT
 W:$Y+1<IOSL ! S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) W @IOF
 Q
AD ; Called by routine YSPTX
 S YSMOR=0 R !!?10,"ALL? Y// ",YSYN:DTIME S YSTOUT='$T,YSUOUT=YSYN["^" G:YSTOUT!YSUOUT END1^YSPTX S YSYN=$TR($E(YSYN),"yn","YN") G MOR:"Y"[YSYN I "N"'[YSYN W:YSYN'["?" " ?",$C(7) G AD
RNG ;
 W !!?3,"Begin ",YSFHDR," NUMBER: " R X:DTIME S YSTOUT='$T,YSUOUT=X["^" G END1^YSPTX:YSTOUT!YSUOUT,RNG:X["?" I '$D(A(+X)) W " ?",$C(7) G RNG
THN ;
 S YSYDT=A(X)+1,YSIDT=9999999-YSYDT W !?3,"Through ",YSFHDR," NUMBER: " R YSTHN:DTIME S YSTOUT='$T,YSUOUT=YSTHN["^" G END1^YSPTX:YSTOUT!YSUOUT I '$D(A(+YSTHN)) W:YSTHN'["?" " ?",$C(7) G THN
 I X'<YSTHN S X1=X,X=YSTHN,YSTHN=X1,YSYDT=A(+X)+1,YSIDT=9999999-YSYDT K X1
 S YSLDT=9999999-A(+YSTHN) G IHD
MOR ;
 S YSIDT=0
IHD ;
 K IOP S %ZIS="Q" D ^%ZIS G:POP END1^YSPTX I $D(IO("Q")) S ZTRTN="ENP2^YSPTXR",ZTSAVE("YS*")="",ZTDESC="YS TEXT PRINT 2" D ^%ZTLOAD G END1^YSPTX
ENP2 ;
 K ^UTILITY($J) S YSMOR=1 D INIT
NIDT ;
 S:'$D(YSLDT) YSLDT=9999999 S YSIDT=$O(^PTX(YSDFN,YSTY,YSIDT)) G:'YSIDT!(YSIDT>YSLDT) END
 S YSYDT=9999999-YSIDT D CP Q:$G(YSLFT)  G NIDT
INIT ;
 S (YSCON,YSLFT)=0,YSP0=$S(IOST?1"P".E:1,1:0),YSPF=$S(YSP0:8,1:3) U IO D ENHD^YSFORM
 Q
ENCN ; Called by routine YSLRP
 S YSTL="CRISIS NOTE",YSTY="CN",YSMOR=1,(YSIDT,YSP0,YSLFT)=0,YSPF=3
 W @IOF,!!?3,YSTL,"(S) FOR ",YSNM,"      ",YSSEX,"      AGE ",YSAGE W:'$D(^PTX(YSDFN,"CNU",DUZ)) $C(7) G NIDT