- 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 Feb 18, 2025@23:43:35 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