YTEXT1 ;SLC/TGA-PRINT COMMENTS ; 7/10/89 11:28 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
S %ZIS="Q",YSN=$P(A1(YSTEST),U),YSD=$P(A1(YSTEST),U,2)
I $D(^YTT(601,"ATN","T",YSN)),'$D(^XUSEC("YSP",DUZ)) W !," You must hold the proper security key for this option." R I#1:DTIME Q
D ^%ZIS I POP S YSLFT=1 Q
I $D(IO("Q")) K IO("Q") S ZTRTN="ENP^YTEXT1",ZTSAVE("YS*")="",ZTDESC="YS COMMENT PRINT" D ^%ZTLOAD Q
ENP ;
S Y=YSD,YSP0=$S(IOST?1"P".E:1,1:0),YSPF=$S(YSP0:8,1:3),YSLFT=0 D DD^%DT S YSFHDR="Staff Comments on "_YSN_" of "_Y U IO D ENHD^YSFORM
S YSI=0 F S YSI=$O(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R","AD",YSI)) Q:'YSI Q:YSLFT S YSJ=0 F S YSJ=$O(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R","AD",YSI,YSJ)) Q:'YSJ D P1 Q:YSLFT
D ENFT^YSFORM:YSP0,WAIT^YSUTL:'YSP0&'YSLFT D KILL^%ZTLOAD,^%ZISC Q
P1 ;
Q:'$D(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSJ,0)) S X=^(0),YSU=$P(X,U,4),YSU(1)=$P(X,U,3),YSES=$P(X,U,5) S Y=YSI ;Q:'YSU!(YSES=""&(DUZ'=YSU)) ;ENABLE PRINT OF ALL COMMENTS
D DD^%DT D:$Y+YSPF+1>IOSL CK Q:YSLFT W !!,Y S DIC="^YTD(601.2,YSDFN,1,YSET,1,YSED,""R"",YSJ,1,",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"
S Z=DIC_"0)",DW2=$P(@(Z),U,4) D:$Y+YSPF+1>IOSL CK Q:YSLFT W !! X DWI Q:YSLFT D ^DIWW D:YSPF+$Y>IOSL CK Q:YSLFT W !,$P($G(^VA(200,+YSU,0)),U) I YSU'=YSU(1) W !," transcribed by: ",$P($G(^VA(200,+YSU(1),0)),U) Q
CK ;
S:YSP0 YSCON=1 D ENFT^YSFORM:YSP0,WAIT^YSUTL:'YSP0 Q:YSLFT D:YSP0 ENHD^YSFORM Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTEXT1 1477 printed Dec 13, 2024@02:17:18 Page 2
YTEXT1 ;SLC/TGA-PRINT COMMENTS ; 7/10/89 11:28 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 SET %ZIS="Q"
SET YSN=$PIECE(A1(YSTEST),U)
SET YSD=$PIECE(A1(YSTEST),U,2)
+4 IF $DATA(^YTT(601,"ATN","T",YSN))
IF '$DATA(^XUSEC("YSP",DUZ))
WRITE !," You must hold the proper security key for this option."
READ I#1:DTIME
QUIT
+5 DO ^%ZIS
IF POP
SET YSLFT=1
QUIT
+6 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="ENP^YTEXT1"
SET ZTSAVE("YS*")=""
SET ZTDESC="YS COMMENT PRINT"
DO ^%ZTLOAD
QUIT
ENP ;
+1 SET Y=YSD
SET YSP0=$SELECT(IOST?1"P".E:1,1:0)
SET YSPF=$SELECT(YSP0:8,1:3)
SET YSLFT=0
DO DD^%DT
SET YSFHDR="Staff Comments on "_YSN_" of "_Y
USE IO
DO ENHD^YSFORM
+2 SET YSI=0
FOR
SET YSI=$ORDER(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R","AD",YSI))
if 'YSI
QUIT
if YSLFT
QUIT
SET YSJ=0
FOR
SET YSJ=$ORDER(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R","AD",YSI,YSJ))
if 'YSJ
QUIT
DO P1
if YSLFT
QUIT
+3 if YSP0
DO ENFT^YSFORM
if 'YSP0&'YSLFT
DO WAIT^YSUTL
DO KILL^%ZTLOAD
DO ^%ZISC
QUIT
P1 ;
+1 ;Q:'YSU!(YSES=""&(DUZ'=YSU)) ;ENABLE PRINT OF ALL COMMENTS
if '$DATA(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSJ,0))
QUIT
SET X=^(0)
SET YSU=$PIECE(X,U,4)
SET YSU(1)=$PIECE(X,U,3)
SET YSES=$PIECE(X,U,5)
SET Y=YSI
+2 DO DD^%DT
if $Y+YSPF+1>IOSL
DO CK
if YSLFT
QUIT
WRITE !!,Y
SET DIC="^YTD(601.2,YSDFN,1,YSET,1,YSED,""R"",YSJ,1,"
SET DIWL=1
SET DIWR=80
SET DIWF="W"
SET DWI="F D=1:1:DW2 S X="_DIC_"D,0) D:$Y+YSPF>IOSL CK Q:YSLFT D ^DIWP"
+3 SET Z=DIC_"0)"
SET DW2=$PIECE(@(Z),U,4)
if $Y+YSPF+1>IOSL
DO CK
if YSLFT
QUIT
WRITE !!
XECUTE DWI
if YSLFT
QUIT
DO ^DIWW
if YSPF+$Y>IOSL
DO CK
if YSLFT
QUIT
WRITE !,$PIECE($GET(^VA(200,+YSU,0)),U)
IF YSU'=YSU(1)
WRITE !," transcribed by: ",$PIECE($GET(^VA(200,+YSU(1),0)),U)
QUIT
CK ;
+1 if YSP0
SET YSCON=1
if YSP0
DO ENFT^YSFORM
if 'YSP0
DO WAIT^YSUTL
if YSLFT
QUIT
if YSP0
DO ENHD^YSFORM
QUIT
