111 lines
4.2 KiB
Mathematica
111 lines
4.2 KiB
Mathematica
YTONLY ;ASF/ALB-Restricted Psych Testing Option ;7/9/96 11:50
|
|
;;5.01;MENTAL HEALTH;**19,37**;Dec 30, 1994
|
|
MAIN ; main loop
|
|
S (YSXT,YSENTRY)=$O(^YTT(601,"B",YSCODE,0))
|
|
S YSXTP=1,T1=1,T1(0)=$P(^YTT(601,YSXT,"P"),U,4)
|
|
S YSPREV=0
|
|
I YSENTRY=""!($P(^YTT(601,YSENTRY,0),U,13)="N") W !,"Instrument "_YSCODE_" not available" H 3 Q
|
|
S YSTITLE=$P($G(^YTT(601,YSENTRY,"P")),U)
|
|
W @IOF,!,$$CJ^XLFSTR(YSTITLE,79," "),!
|
|
D PT G END:$G(YSDFN)<1
|
|
D NX,PREV
|
|
D OPT1 Q:$D(DIRUT)
|
|
D ADMIN:YSOPT="A",PRINT:YSOPT="P",CLERK:YSOPT="C"
|
|
;
|
|
G MAIN
|
|
ADMIN ;
|
|
K J
|
|
I $D(^YTD(601.4,YSDFN,1,YSENTRY)) G RESTART
|
|
S YSOK=1 W !! S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Professional requesting instrument: ",DIC("B")=DUZ D ^DIC K DIC I Y<1 S YSOK=-1 Q
|
|
S YSORD=+Y
|
|
S YSQ=0 D A31^YTCLERK1 I YSOK<1 D KAR^YTS Q
|
|
I YSQ S ZTIO=ION D HOME^%ZIS
|
|
S YSTEST=YSENTRY,YSXT=YSENTRY,YSXTP=1
|
|
D A4^YTAR
|
|
Q
|
|
RESTART ;
|
|
K DIR S DIR(0)="S^R:Restart "_YSCODE_";D:Delete previous incomplete and adminster;Q:Quit"
|
|
D ^DIR K DIR
|
|
Q:$D(DIRUT)!(Y="Q")
|
|
I Y="D" S YSTEST=YSENTRY D KT,ADMIN Q
|
|
S YSTEST=YSENTRY
|
|
S YTLM=$P($G(^YSA(602,1,0)),U,3) S:YTLM="" YTLM=3
|
|
I $P($G(^YTT(601,YSTEST,0)),U,16) S YTLM=$P(^(0),U,16)
|
|
S X2=$S($P(^YTD(601.4,YSDFN,1,YSTEST,0),U,8):$P(^(0),U,8),1:$P(^(0),U,2))
|
|
S X=$$FMDIFF^XLFDT(DT,X2,1)
|
|
I X>YTLM W !,"Administration discontinued more than "_YTLM_" days ago -- not restartable" H 2 Q
|
|
S YSTEST=YSENTRY
|
|
S (B,C)="",J=+$P(^YTD(601.4,YSDFN,1,YSENTRY,0),U,4),C=$P(^(0),U,5),YSORD=$P(^(0),U,7) S:$P(^(0),U,8) YSBEGIN=$P(^(0),U,8)
|
|
I $D(^YTD(601.4,YSDFN,1,YSENTRY,"B"))#2 S B=^("B")
|
|
S YSRP=$S(J#200=1:"",1:^YTD(601.4,YSDFN,1,YSENTRY,J+198\200)) S:'J J=1
|
|
S YSXT=YSTEST_"^" S:$D(^YTD(601.4,YSDFN,1,YSENTRY,"R")) YSXT=YSXT_^("R") S YSXTP=1,YSDEMO="N",YSRESTRT=1
|
|
S YSQ=0 D A31^YTCLERK1 I YSOK<1 D KAR^YTS Q
|
|
I YSQ S ZTIO=ION D HOME^%ZIS
|
|
D A4^YTAR
|
|
Q
|
|
PRINT ;
|
|
S YSXT=""
|
|
W !
|
|
D DU^YTDP
|
|
Q
|
|
CLERK ;
|
|
S YSCL=1,(YTESTN,YSTESTN)=YSCODE,YSCLERK=14,YSENT=14,YSTEST=YSENTRY,YSNQ=$P(^YTT(601,YSENTRY,0),U,11)
|
|
I $D(^YTD(601.4,YSDFN,1,"AC",YSENTRY)) W !!,"Discontinued CLERK test found:" G RESTART^YTCLERK1
|
|
I $D(^YTD(601.4,YSDFN)) S DIK="^YTD(601.4,",DA=YSDFN D ^DIK K DIK
|
|
S YSOK=1 W !! S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Professional requesting instrument: ",DIC("B")=DUZ D ^DIC K DIC I Y<1 S YSOK=-1 Q
|
|
S YSORD=+Y
|
|
S YSQ=0 D A31^YTCLERK1 I YSOK<1 D KAR^YTS Q
|
|
S (J,YSXTP)=1,(B,C,YSRP)=""
|
|
D REY1^YTCLERK
|
|
Q
|
|
PT ;
|
|
D ^YSLRP G:YSDFN<1 END D ENPT^YSUTL
|
|
I YSSEX="" W !,"Gender not poperly specified. Call IRM" H 3 G MAIN
|
|
Q
|
|
OPT1 ;admin, clerk, print
|
|
W !
|
|
K DIR
|
|
S DIR(0)="S^A:Administer on-line;C:Clerk entry"
|
|
S:YSPREV DIR(0)=DIR(0)_";P:Print"
|
|
S DIR("A")=$S(YSPREV:"Administer on-line, Clerk entry or Print",1:"Administer on-line or Clerk entry")
|
|
D ^DIR
|
|
S YSOPT=Y
|
|
K DIR
|
|
G MAIN:$D(DIRUT)
|
|
Q
|
|
NX ;
|
|
K A,A1
|
|
S %=$H>21549+$H-.1,%Y=%\365.25+141,%=%#365.25\1,YSPTD=%+306#(%Y#4=0+365)#153#61#31+1,YSPTM=%-YSPTD\29+1,Y=%Y_"00"+YSPTM_"00"+YSPTD,YSDT(0)=$$FMTE^XLFDT(Y,"5ZD")
|
|
S YSSX=YSSEX,YSBL=" ",YSHDR=YSSSN_" "_YSNM_YSBL_YSBL_YSBL,YSHDR=$E(YSHDR,1,44)_YSSX_" AGE "_YSAGE,YSHD=DT
|
|
S YSHDT=""
|
|
I '$D(^YTD(601.2,YSDFN,1,YSENTRY)) K A,A1 Q
|
|
S YSNT=0,N2=0 F S N2=$O(^YTD(601.2,YSDFN,1,YSENTRY,1,N2)) Q:'N2 S A(YSCODE,N2)=YSENTRY,YSNT=YSNT+1,A1(YSNT)=YSCODE_U_N2_U_YSENTRY
|
|
Q
|
|
PREV ;
|
|
W @IOF,YSHDR
|
|
I '$D(A1(1)),'$D(^YTD(601.4,YSDFN,1,YSENTRY,0)),'$D(^YTD(601.4,YSDFN,1,"AC",YSENTRY)) W !!,?10,"No Previous Administrations on File" S YSPREV=0 Q
|
|
I $D(^YTD(601.4,YSDFN,1,YSENTRY,0)) W !!,"Incomplete "_YSCODE_" on-line administration found on " S Y=$P(^(0),U,2) X ^DD("DD") W Y Q
|
|
I $D(^YTD(601.4,YSDFN,1,"AC",YSENTRY)) W !!,"Incomplete "_YSCODE_" clerk entry found on " S Y=$P(^YTD(601.4,YSDFN,1,14,0),U,2) X ^DD("DD") W Y Q
|
|
;
|
|
W !!,"Previous Administrations of the",$S(YSTITLE["*":$TR(YSTITLE,"*",""),YSTITLE["-":$TR(YSTITLE,"-",""),1:" "_YSTITLE),!!
|
|
F I=1:1 Q:'$D(A1(I)) D
|
|
. S YSPREV=I
|
|
. S Y=$P(A1(I),U,2)
|
|
. X ^DD("DD")
|
|
. W:$X>60 !
|
|
. W $J(I,3)_" "_Y_" "
|
|
Q
|
|
KT ;
|
|
K J I $D(^YTD(601.4,YSDFN,1,YSTEST)) S YSENTRY=YSTEST D ENKIL^YTFILE
|
|
Q
|
|
SF36 ;
|
|
S YSCODE="SF36" G MAIN
|
|
;
|
|
END ;
|
|
D KVAR^VADPT
|
|
K %,%Y,A,A1,B,C,I,J,N2,T1,X,X2,Y,YSAGE,YSBEGIN,YSBL,YSCL,YSCLERK
|
|
K YSCODE,YSDEMO,YSDFN,YSDT,YSENT,YSENTRY,YSHD,YSHDR,YSHDT,YSNM,YSNQ
|
|
K YSNT,YSOK,YSOPT,YSORD,YSPREV,YSPTD,YSPTM,YSQ,YSRESTRT,YSRP,YSSEX
|
|
K YSSSN,YSSX,YSTEST,YSTESTN,YSTITLE,YSXT,YSXTP,YTESTN,YTLM
|
|
Q
|