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
Q
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 !
Q
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)=""
Q
LP ;loop thru TMP
F YSCALEN=1:1:YSSNUMB W !,$J($P($P(^YTT(601,YSTEST,"S",YSCALEN,0),U,2)," "),5)," " D LP1
Q
LP1 S YSDATES=0 F S YSDATES=$O(YSDATES(YSDATES)) Q:YSDATES'>0 S YSED=9999999-YSDATES D LP2
Q
LP2 S Y=^TMP("YSMTI",$J,YSDFN,YSTEST,YSCALEN,YSED)
S S=$P(Y,U,2) W $J(S,6),?$X+3
Q
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
Q
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSMTI0 2093 printed Apr 09, 2024@21:15:43 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
