YTDP1 ;SLC/TGA-STAFF COMMENTS ON TEST/INTERVIEWS ; 10/20/88 08:36 ;
;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
;
S YSLFT=0,P0=$S(IOST?1"C-".E:0,1:1) D DTA^YTREPT,HDR
S YSI=0 F S YSI=$O(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R","AD",YSI)) Q:'YSI!(YSLFT) S YSJ=0 F S YSJ=$O(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R","AD",YSI,YSJ)) Q:'YSJ Q:'$D(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSJ,0)) S X=^(0) D PC1 Q:YSLFT
K D,DIW,DIWF,DIWL,DIWR,DIWT,DN,DW2,DWI,I,YSI,YSJ,YSU Q
PC1 ;
S YSU=$P(X,U,4),YSES=$P(X,U,5) Q:YSU<1 Q:YSES=""&(DUZ'=YSU) D:$Y+$S(P0:11,1:6)>IOSL CK Q:YSLFT
S Y=YSI D DD^%DT 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+$S(P0:9,1:4)>IOSL CK Q:YSLFT D ^DIWP"
S Z=DIC_"0)",DW2=$P(@(Z),U,4) D:$Y+$S(P0:10,1:5)>IOSL CK Q:YSLFT W !! X DWI Q:YSLFT D ^DIWW D:$Y+$S(P0:10,1:4)>IOSL CK Q:YSLFT W ! W:P0 !! W $P($G(^VA(200,+YSU,0)),U)
I P0 W !,"NOT VALID UNLESS SIGNED" Q
HDR ;
W !!,"Staff Remarks on ",$P(^YTT(601,YSTEST,0),U)," of ",$$FMTE^XLFDT(YSED,"5ZD") Q
CK ;
D:'P0 WAIT^YSUTL Q:YSLFT D:P0 DTA^YTREPT,HDR Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTDP1 1109 printed Nov 22, 2024@17:27:17 Page 2
YTDP1 ;SLC/TGA-STAFF COMMENTS ON TEST/INTERVIEWS ; 10/20/88 08:36 ;
+1 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
+2 ;
+3 SET YSLFT=0
SET P0=$SELECT(IOST?1"C-".E:0,1:1)
DO DTA^YTREPT
DO HDR
+4 SET YSI=0
FOR
SET YSI=$ORDER(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R","AD",YSI))
if 'YSI!(YSLFT)
QUIT
SET YSJ=0
FOR
SET YSJ=$ORDER(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R","AD",YSI,YSJ))
if 'YSJ
QUIT
if '$DATA(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSJ,0))
QUIT
SET X=^(0)
DO PC1
if YSLFT
QUIT
+5 KILL D,DIW,DIWF,DIWL,DIWR,DIWT,DN,DW2,DWI,I,YSI,YSJ,YSU
QUIT
PC1 ;
+1 SET YSU=$PIECE(X,U,4)
SET YSES=$PIECE(X,U,5)
if YSU<1
QUIT
if YSES=""&(DUZ'=YSU)
QUIT
if $Y+$SELECT(P0
DO CK
if YSLFT
QUIT
+2 SET Y=YSI
DO DD^%DT
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+$S(P0:9,1:4)>IOSL CK Q:YSLFT D ^DIWP"
+3 SET Z=DIC_"0)"
SET DW2=$PIECE(@(Z),U,4)
if $Y+$SELECT(P0
DO CK
if YSLFT
QUIT
WRITE !!
XECUTE DWI
if YSLFT
QUIT
DO ^DIWW
if $Y+$SELECT(P0
DO CK
if YSLFT
QUIT
WRITE !
if P0
WRITE !!
WRITE $PIECE($GET(^VA(200,+YSU,0)),U)
+4 IF P0
WRITE !,"NOT VALID UNLESS SIGNED"
QUIT
HDR ;
+1 WRITE !!,"Staff Remarks on ",$PIECE(^YTT(601,YSTEST,0),U)," of ",$$FMTE^XLFDT(YSED,"5ZD")
QUIT
CK ;
+1 if 'P0
DO WAIT^YSUTL
if YSLFT
QUIT
if P0
DO DTA^YTREPT
DO HDR
QUIT
