Routine: YSMTI0

YSMTI0 ;ALB/ASF - MUTLIPLE PSYCH TESTS FULL PROFILES ;7/23/99  10:36

 ;;5.01;MENTAL HEALTH;**53,187**;Dec 30, 1994;Build 73

 K IOP S %ZIS="Q" D ^%ZIS Q:POP

 I $D(IO("Q")) K IO("Q") S ZTRTN="ENTASK^YSMTI0",ZTDESC="YSMTI0" S ZTSAVE("YS*")="" D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7)

 U IO D DATES,TOP,LP,HOME^%ZIS D ^%ZISC U IO

ENTASK ;taskman entry

 S:$D(ZTQUEUED) ZTREQ="@"

 D ENFRNT^YSMTI,TOP,LP Q

TOP ;

 S YSLN="",$P(YSLN,"_",79)=""

 W @IOF,!?10,"**** M U L T I P L E   T E S T   A D M I N I S T R A T I O N S ***"

 W !,VADM(1),?40,"SSN: xxx-xx-"_$E($P(VADM(2),U,2),8,11),"  ",$P(VADM(5),U,2),?60,"  DOB: ",$P(VADM(3),U,2)

 S X=$P(^YTT(601,YSTEST,"P"),U) W !?(72-$L(X)/2),X

 W !,YSLN

 W !,"Scales",?15,"Administrations",!,YSLN,!?4

 ;S Y=0 F I=1:1:8 S Y=$O(YSDATES(Y)) Q:Y'>0  W $J($$FMTE^XLFDT(9999999-Y,"2D"),9)

 S Y=0 F I=1:1:8 S Y=$O(YSDATES(Y)) Q:Y'>0  W $J($$FMTE^XLFDT(9999999-Y,"5D"),10)

 ;W !

DATES ;

 S YSSNUMB=$P(^YTT(601,YSTEST,0),U),YSSNUMB=$S(YSSNUMB?1"MC".E:25,1:13)

 K YSDATES S YSDATES=0 F  S YSDATES=$O(^TMP("YSMTI",$J,YSDFN,YSTEST,1,YSDATES)) Q:YSDATES'>0  S YSDATES(9999999-YSDATES)=""

LP ;loop thru TMP

 F YSCALEN=1:1:YSSNUMB W !,$J($P($P(^YTT(601,YSTEST,"S",YSCALEN,0),U,2)," "),5)," "  D LP1

LP1 S YSDATES=0 F  S YSDATES=$O(YSDATES(YSDATES)) Q:YSDATES'>0  S YSED=9999999-YSDATES D LP2

LP2 S Y=^TMP("YSMTI",$J,YSDFN,YSTEST,YSCALEN,YSED)

 S S=$P(Y,U,2) W $J(S,6),?$X+3

FRONT ; front end output

 S YSDFN=P3,(YSET,YSTEST)=P4 K ^TMP("YSMTI",$J)

 S YSSNUMB=$P(^YTT(601,YSTEST,0),U),YSSNUMB=$S(YSSNUMB?1"MC".E:25,1:13)

 D ENFRNT^YSMTI

 W "11111<BOT>",$C(13)

FOUT1 ;

 F YSNSCALE=1:1:YSSNUMB D FOUT2

 W "<EOT>",$C(13) Q

FOUT2 S YSED=0 F  S YSED=$O(^TMP("YSMTI",$J,YSDFN,YSET,YSNSCALE,YSED)) Q:YSED'>0  D FRONT1

FRONT1 S Y=^TMP("YSMTI",$J,YSDFN,YSET,YSNSCALE,YSED)

 ;S Y1=$P(^YTT(601,YSET,0),U,1)_U_$E(YSED,4,5)_"/"_$E(YSED,6,7)_"/"_$E(YSED,2,3)_U_YSNSCALE_U_$P(Y,U,1)_U_$P(Y,U,2)

 S Y1=$P(^YTT(601,YSET,0),U,1)_U_$$FMTE^XLFDT(YSED,"5ZD")_U_YSNSCALE_U_$P(Y,U,1)_U_$P(Y,U,2)

 W Y1,$C(13)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSMTI0   2093     printed  Mar 13, 2025@21:19:31                                                                                                                                                                                                      Page 2

YSMTI0    ;ALB/ASF - MUTLIPLE PSYCH TESTS FULL PROFILES ;7/23/99  10:36

 +1       ;;5.01;MENTAL HEALTH;**53,187**;Dec 30, 1994;Build 73

 +2       ;

 +3        KILL IOP

           SET %ZIS="Q"

           DO ^%ZIS

           if POP

               QUIT

 +4        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTRTN="ENTASK^YSMTI0"

               SET ZTDESC="YSMTI0"

               SET ZTSAVE("YS*")=""

               DO ^%ZTLOAD

               WRITE !,$SELECT($DATA(ZTSK):"QUEUED",1:"Not queued"),$CHAR(7)

 +5        USE IO

           DO DATES

           DO TOP

           DO LP

           DO HOME^%ZIS

           DO ^%ZISC

           USE IO

 +6        QUIT

ENTASK    ;taskman entry

 +1        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        DO ENFRNT^YSMTI

           DO TOP

           DO LP

           QUIT

TOP       ;

 +1        SET YSLN=""

           SET $PIECE(YSLN,"_",79)=""

 +2        WRITE @IOF,!?10,"**** M U L T I P L E   T E S T   A D M I N I S T R A T I O N S ***"

 +3        WRITE !,VADM(1),?40,"SSN: xxx-xx-"_$EXTRACT($PIECE(VADM(2),U,2),8,11),"  ",$PIECE(VADM(5),U,2),?60,"  DOB: ",$PIECE(VADM(3),U,2)

 +4        SET X=$PIECE(^YTT(601,YSTEST,"P"),U)

           WRITE !?(72-$LENGTH(X)/2),X

 +5        WRITE !,YSLN

 +6        WRITE !,"Scales",?15,"Administrations",!,YSLN,!?4

 +7       ;S Y=0 F I=1:1:8 S Y=$O(YSDATES(Y)) Q:Y'>0  W $J($$FMTE^XLFDT(9999999-Y,"2D"),9)

 +8        SET Y=0

           FOR I=1:1:8

               SET Y=$ORDER(YSDATES(Y))

               if Y'>0

                   QUIT

               WRITE $JUSTIFY($$FMTE^XLFDT(9999999-Y,"5D"),10)

 +9       ;W !

 +10       QUIT

DATES     ;

 +1        SET YSSNUMB=$PIECE(^YTT(601,YSTEST,0),U)

           SET YSSNUMB=$SELECT(YSSNUMB?1"MC".E:25,1:13)

 +2        KILL YSDATES

           SET YSDATES=0

FOR

               SET YSDATES=$ORDER(^TMP("YSMTI",$JOB,YSDFN,YSTEST,1,YSDATES))

               if YSDATES'>0

                   QUIT

               SET YSDATES(9999999-YSDATES)=""

 +3        QUIT

LP        ;loop thru TMP

 +1        FOR YSCALEN=1:1:YSSNUMB

               WRITE !,$JUSTIFY($PIECE($PIECE(^YTT(601,YSTEST,"S",YSCALEN,0),U,2)," "),5)," "

               DO LP1

 +2        QUIT

LP1        SET YSDATES=0

FOR

               SET YSDATES=$ORDER(YSDATES(YSDATES))

               if YSDATES'>0

                   QUIT

               SET YSED=9999999-YSDATES

               DO LP2

 +1        QUIT

LP2        SET Y=^TMP("YSMTI",$JOB,YSDFN,YSTEST,YSCALEN,YSED)

 +1        SET S=$PIECE(Y,U,2)

           WRITE $JUSTIFY(S,6),?$X+3

 +2        QUIT

FRONT     ; front end output

 +1        SET YSDFN=P3

           SET (YSET,YSTEST)=P4

           KILL ^TMP("YSMTI",$JOB)

 +2        SET YSSNUMB=$PIECE(^YTT(601,YSTEST,0),U)

           SET YSSNUMB=$SELECT(YSSNUMB?1"MC".E:25,1:13)

 +3        DO ENFRNT^YSMTI

 +4        WRITE "11111<BOT>",$CHAR(13)

FOUT1     ;

 +1        FOR YSNSCALE=1:1:YSSNUMB

               DO FOUT2

 +2        WRITE "<EOT>",$CHAR(13)

           QUIT

FOUT2      SET YSED=0

FOR

               SET YSED=$ORDER(^TMP("YSMTI",$JOB,YSDFN,YSET,YSNSCALE,YSED))

               if YSED'>0

                   QUIT

               DO FRONT1

 +1        QUIT

FRONT1     SET Y=^TMP("YSMTI",$JOB,YSDFN,YSET,YSNSCALE,YSED)

 +1       ;S Y1=$P(^YTT(601,YSET,0),U,1)_U_$E(YSED,4,5)_"/"_$E(YSED,6,7)_"/"_$E(YSED,2,3)_U_YSNSCALE_U_$P(Y,U,1)_U_$P(Y,U,2)

 +2        SET Y1=$PIECE(^YTT(601,YSET,0),U,1)_U_$$FMTE^XLFDT(YSED,"5ZD")_U_YSNSCALE_U_$PIECE(Y,U,1)_U_$PIECE(Y,U,2)

 +3        WRITE Y1,$CHAR(13)

 +4        QUIT

YSMTI0.m