YTDP1.m

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 ---YTDP1   1109     printed  Apr 09, 2024@21:20:12                                                                                                                                                                                                       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