- YSMTI ;ALB/ASF - MUTLIPLE PSYCH TESTS AND INTERVIEWS ;7/23/99 09:50
- ;;5.01;MENTAL HEALTH;**53,187**;Dec 30, 1994;Build 73
- ;
- W @IOF,!?10,"Psychological Testing Mutliple Administraion Reporting",!
- PTALL ; SELECT PT
- W ! K DIC,DIK S YSDFN=0,DIC("A")="Select Patient: ",DIC="^YTD(601.2,",DIC(0)="AEQ" D ^DIC Q:Y'>0 S YSDFN=+Y
- K ^TMP("YSMTI",$J,YSDFN)
- I $O(^YTD(601.2,YSDFN,1,0))'>0 W !,"No Tests found" Q
- SELTST ;select test
- K DIC S DIC="^YTD(601.2,YSDFN,1,",DIC(0)="AEMZ" D ^DIC Q:Y'>0 S (YSET,YSTEST)=+Y,YSTESTA=$P(^YTT(601,YSTEST,0),U)
- I $P(^YTT(601,YSTEST,0),U,9)'="T" W !,"Only Tests can be graphed" H 2 G SELTST
- D ENFRNT
- SELSCAL ;
- S Y="N" I YSTESTA?1."MMP".E!(YSTESTA?1"MCMI".E) K DIR S DIR("A")="Show Full Profile? ",DIR("B")="NO",DIR(0)="Y" D ^DIR Q:$D(DIROUT)
- I Y=1 D ^YSMTI0 G SELSCAL
- K DIC S DIC("A")="Select Scale Number or Name: ",DIC(0)="AEQZM",DIC="^YTT(601,YSTEST,"""_"S"_""",",DIC("W")="W ?10,$P(^(0),U,2)" D ^DIC G:Y'>0 SELTST S YSCALEN=+Y,YSCALET=$P(Y(0),U,2)
- K IOP S %ZIS="Q" D ^%ZIS Q:POP
- I $D(IO("Q")) K IO("Q") S ZTRTN="ENTASK^YSMTI",ZTDESC="YSMTI" S ZTSAVE("YS*")="" D ^%ZTLOAD W !,$S($D(ZTSK):"QUEUED",1:"Not queued"),$C(7) G SELSCAL
- U IO D HDR,CR,HOME^%ZIS D ^%ZISC U IO
- G SELSCAL
- ENTASK ;taskman entry
- S:$D(ZTQUEUED) ZTREQ="@"
- D ENFRNT,HDR,CR Q
- HDR ;
- S YSLN="",$P(YSLN,"_",79)=""
- W @IOF,!?7,"**** 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
- S X="Scale: "_YSCALET W !,YSLN,!?(72-$L(X)/2),X,!,YSLN
- W !,"Entered: Days between Raw Scaled"
- Q
- CR ;loop thru TMP
- S (YSED,YSED1)=0 F S YSED=$O(^TMP("YSMTI",$J,YSDFN,YSTEST,YSCALEN,YSED)) Q:YSED'>0 D CR1 S YSED1=YSED
- W !! Q
- CR1 S Y=^TMP("YSMTI",$J,YSDFN,YSTEST,YSCALEN,YSED)
- S R=$P(Y,U),S=$P(Y,U,2) S:YSED1 YSED1=$$FMDIFF^XLFDT(YSED,YSED1,1)
- ;W !,$E(YSED,4,5)_"/"_$E(YSED,6,7)_"/"_$E(YSED,2,3),?12,$S(YSED1:$J(YSED1,5),1:" "),?22,$J(R,6)," ",$J(S,6)
- W !,$$FMTE^XLFDT(YSED,"5ZD"),?14,$S(YSED1:$J(YSED1,5),1:" "),?24,$J(R,6)," ",$J(S,6)
- Q
- ENFRNT ;
- S YSET=YSTEST,DFN=YSDFN D DEM^VADPT,PID^VADPT
- S YSNM=VADM(1),(YSSX,YSSEX)=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID")
- LK2 ;LOOP THRU DATES
- S (YSDAT,YSED)=0 F S YSED=$O(^YTD(601.2,YSDFN,1,YSTEST,1,YSED)) Q:YSED'>0 S YSDAT=YSED D EXEC,FSD
- Q
- EXEC ;SELECT TYPE OF TEST AND EXECUTE PROPER RTN
- K S,R S YSTN=$P(^YTT(601,YSTEST,0),U) Q:'$D(^YTT(601,YSTEST,"R")) S X=^YTT(601,YSTEST,"R")
- S YSR(0)=$G(^YTT(601.6,YSET,0))
- I $P(YSR(0),U,2)="Y" S X=^YTT(601.6,YSET,1) X X
- Q
- FSD ;file scale data
- I '$D(R) S ^TMP("YSMTI",$J,YSDFN,YSET,1,YSED)="" Q
- I $L(R) F I=1:1 Q:$P(R,U,I)="" S ^TMP("YSMTI",$J,YSDFN,YSET,I,YSED)=$P(R,U,I) S:$D(S) $P(^(YSED),U,2)=$P(S,U,I)
- S I1=0,YSCALEN=0 F S I1=$O(R(I1)) Q:I1'>0 D FSD1
- Q
- FSD1 ;
- F I=1:1 Q:$P(R(I1),U,I)="" S YSCALEN=YSCALEN+1,^TMP("YSMTI",$J,YSDFN,YSET,YSCALEN,YSED)=$P(R(I1),U,I) S:$D(S(I1)) $P(^(YSED),U,2)=$P(S(I1),U,I)
- Q
- FRONT ; front end output
- S YSDFN=P3,(YSET,YSTEST)=P4,YSNSCALE=P5 K ^TMP("YSMTI",$J)
- D ENFRNT
- W "11111<BOT>",$C(13)
- FOUT2 S YSED=0 F S YSED=$O(^TMP("YSMTI",$J,YSDFN,YSET,YSNSCALE,YSED)) Q:YSED'>0 D FRONT1
- W "<EOT>",$C(13) 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_$S(+Y:YSNSCALE,1:"")_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_$S(+Y:YSNSCALE,1:"")_U_$P(Y,U,1)_U_$P(Y,U,2)
- W Y1,$C(13)
- Q
- TLIST ;list of tests for a pt
- S YSDFN=P3 W "11111<BOT>",$C(13)
- S YSTEST=0 F S YSTEST=$O(^YTD(601.2,YSDFN,1,YSTEST)) Q:YSTEST'>0 I $D(^YTT(601,YSTEST,0)) W YSTEST_U_$P(^YTT(601,YSTEST,0),U)_U_$P(^YTT(601,YSTEST,"P"),"---",2)_$C(13)
- W "<EOT>",$C(13) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSMTI 3893 printed Mar 13, 2025@21:19:30 Page 2
- YSMTI ;ALB/ASF - MUTLIPLE PSYCH TESTS AND INTERVIEWS ;7/23/99 09:50
- +1 ;;5.01;MENTAL HEALTH;**53,187**;Dec 30, 1994;Build 73
- +2 ;
- +3 WRITE @IOF,!?10,"Psychological Testing Mutliple Administraion Reporting",!
- PTALL ; SELECT PT
- +1 WRITE !
- KILL DIC,DIK
- SET YSDFN=0
- SET DIC("A")="Select Patient: "
- SET DIC="^YTD(601.2,"
- SET DIC(0)="AEQ"
- DO ^DIC
- if Y'>0
- QUIT
- SET YSDFN=+Y
- +2 KILL ^TMP("YSMTI",$JOB,YSDFN)
- +3 IF $ORDER(^YTD(601.2,YSDFN,1,0))'>0
- WRITE !,"No Tests found"
- QUIT
- SELTST ;select test
- +1 KILL DIC
- SET DIC="^YTD(601.2,YSDFN,1,"
- SET DIC(0)="AEMZ"
- DO ^DIC
- if Y'>0
- QUIT
- SET (YSET,YSTEST)=+Y
- SET YSTESTA=$PIECE(^YTT(601,YSTEST,0),U)
- +2 IF $PIECE(^YTT(601,YSTEST,0),U,9)'="T"
- WRITE !,"Only Tests can be graphed"
- HANG 2
- GOTO SELTST
- +3 DO ENFRNT
- SELSCAL ;
- +1 SET Y="N"
- IF YSTESTA?1."MMP".E!(YSTESTA?1"MCMI".E)
- KILL DIR
- SET DIR("A")="Show Full Profile? "
- SET DIR("B")="NO"
- SET DIR(0)="Y"
- DO ^DIR
- if $DATA(DIROUT)
- QUIT
- +2 IF Y=1
- DO ^YSMTI0
- GOTO SELSCAL
- +3 KILL DIC
- SET DIC("A")="Select Scale Number or Name: "
- SET DIC(0)="AEQZM"
- SET DIC="^YTT(601,YSTEST,"""_"S"_""","
- SET DIC("W")="W ?10,$P(^(0),U,2)"
- DO ^DIC
- if Y'>0
- GOTO SELTST
- SET YSCALEN=+Y
- SET YSCALET=$PIECE(Y(0),U,2)
- +4 KILL IOP
- SET %ZIS="Q"
- DO ^%ZIS
- if POP
- QUIT
- +5 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="ENTASK^YSMTI"
- SET ZTDESC="YSMTI"
- SET ZTSAVE("YS*")=""
- DO ^%ZTLOAD
- WRITE !,$SELECT($DATA(ZTSK):"QUEUED",1:"Not queued"),$CHAR(7)
- GOTO SELSCAL
- +6 USE IO
- DO HDR
- DO CR
- DO HOME^%ZIS
- DO ^%ZISC
- USE IO
- +7 GOTO SELSCAL
- ENTASK ;taskman entry
- +1 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 DO ENFRNT
- DO HDR
- DO CR
- QUIT
- HDR ;
- +1 SET YSLN=""
- SET $PIECE(YSLN,"_",79)=""
- +2 WRITE @IOF,!?7,"**** 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 SET X="Scale: "_YSCALET
- WRITE !,YSLN,!?(72-$LENGTH(X)/2),X,!,YSLN
- +6 WRITE !,"Entered: Days between Raw Scaled"
- +7 QUIT
- CR ;loop thru TMP
- +1 SET (YSED,YSED1)=0
- FOR
- SET YSED=$ORDER(^TMP("YSMTI",$JOB,YSDFN,YSTEST,YSCALEN,YSED))
- if YSED'>0
- QUIT
- DO CR1
- SET YSED1=YSED
- +2 WRITE !!
- QUIT
- CR1 SET Y=^TMP("YSMTI",$JOB,YSDFN,YSTEST,YSCALEN,YSED)
- +1 SET R=$PIECE(Y,U)
- SET S=$PIECE(Y,U,2)
- if YSED1
- SET YSED1=$$FMDIFF^XLFDT(YSED,YSED1,1)
- +2 ;W !,$E(YSED,4,5)_"/"_$E(YSED,6,7)_"/"_$E(YSED,2,3),?12,$S(YSED1:$J(YSED1,5),1:" "),?22,$J(R,6)," ",$J(S,6)
- +3 WRITE !,$$FMTE^XLFDT(YSED,"5ZD"),?14,$SELECT(YSED1:$JUSTIFY(YSED1,5),1:" "),?24,$JUSTIFY(R,6)," ",$JUSTIFY(S,6)
- +4 QUIT
- ENFRNT ;
- +1 SET YSET=YSTEST
- SET DFN=YSDFN
- DO DEM^VADPT
- DO PID^VADPT
- +2 SET YSNM=VADM(1)
- SET (YSSX,YSSEX)=$PIECE(VADM(5),U)
- SET YSDOB=$PIECE(VADM(3),U,2)
- SET YSAGE=VADM(4)
- SET YSSSN=VA("PID")
- LK2 ;LOOP THRU DATES
- +1 SET (YSDAT,YSED)=0
- FOR
- SET YSED=$ORDER(^YTD(601.2,YSDFN,1,YSTEST,1,YSED))
- if YSED'>0
- QUIT
- SET YSDAT=YSED
- DO EXEC
- DO FSD
- +2 QUIT
- EXEC ;SELECT TYPE OF TEST AND EXECUTE PROPER RTN
- +1 KILL S,R
- SET YSTN=$PIECE(^YTT(601,YSTEST,0),U)
- if '$DATA(^YTT(601,YSTEST,"R"))
- QUIT
- SET X=^YTT(601,YSTEST,"R")
- +2 SET YSR(0)=$GET(^YTT(601.6,YSET,0))
- +3 IF $PIECE(YSR(0),U,2)="Y"
- SET X=^YTT(601.6,YSET,1)
- XECUTE X
- +4 QUIT
- FSD ;file scale data
- +1 IF '$DATA(R)
- SET ^TMP("YSMTI",$JOB,YSDFN,YSET,1,YSED)=""
- QUIT
- +2 IF $LENGTH(R)
- FOR I=1:1
- if $PIECE(R,U,I)=""
- QUIT
- SET ^TMP("YSMTI",$JOB,YSDFN,YSET,I,YSED)=$PIECE(R,U,I)
- if $DATA(S)
- SET $PIECE(^(YSED),U,2)=$PIECE(S,U,I)
- +3 SET I1=0
- SET YSCALEN=0
- FOR
- SET I1=$ORDER(R(I1))
- if I1'>0
- QUIT
- DO FSD1
- +4 QUIT
- FSD1 ;
- +1 FOR I=1:1
- if $PIECE(R(I1),U,I)=""
- QUIT
- SET YSCALEN=YSCALEN+1
- SET ^TMP("YSMTI",$JOB,YSDFN,YSET,YSCALEN,YSED)=$PIECE(R(I1),U,I)
- if $DATA(S(I1))
- SET $PIECE(^(YSED),U,2)=$PIECE(S(I1),U,I)
- +2 QUIT
- FRONT ; front end output
- +1 SET YSDFN=P3
- SET (YSET,YSTEST)=P4
- SET YSNSCALE=P5
- KILL ^TMP("YSMTI",$JOB)
- +2 DO ENFRNT
- +3 WRITE "11111<BOT>",$CHAR(13)
- FOUT2 SET YSED=0
- FOR
- SET YSED=$ORDER(^TMP("YSMTI",$JOB,YSDFN,YSET,YSNSCALE,YSED))
- if YSED'>0
- QUIT
- DO FRONT1
- +1 WRITE "<EOT>",$CHAR(13)
- 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_$S(+Y:YSNSCALE,1:"")_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_$SELECT(+Y:YSNSCALE,1:"")_U_$PIECE(Y,U,1)_U_$PIECE(Y,U,2)
- +3 WRITE Y1,$CHAR(13)
- +4 QUIT
- TLIST ;list of tests for a pt
- +1 SET YSDFN=P3
- WRITE "11111<BOT>",$CHAR(13)
- +2 SET YSTEST=0
- FOR
- SET YSTEST=$ORDER(^YTD(601.2,YSDFN,1,YSTEST))
- if YSTEST'>0
- QUIT
- IF $DATA(^YTT(601,YSTEST,0))
- WRITE YSTEST_U_$PIECE(^YTT(601,YSTEST,0),U)_U_$PIECE(^YTT(601,YSTEST,"P"),"---",2)_$CHAR(13)
- +3 WRITE "<EOT>",$CHAR(13)
- QUIT
