close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTONLY.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTONLY.m@ 1780

Last change on this file since 1780 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
1YTONLY ;ASF/ALB-Restricted Psych Testing Option ;7/9/96 11:50
2 ;;5.01;MENTAL HEALTH;**19,37**;Dec 30, 1994
3MAIN ; main loop
4 S (YSXT,YSENTRY)=$O(^YTT(601,"B",YSCODE,0))
5 S YSXTP=1,T1=1,T1(0)=$P(^YTT(601,YSXT,"P"),U,4)
6 S YSPREV=0
7 I YSENTRY=""!($P(^YTT(601,YSENTRY,0),U,13)="N") W !,"Instrument "_YSCODE_" not available" H 3 Q
8 S YSTITLE=$P($G(^YTT(601,YSENTRY,"P")),U)
9 W @IOF,!,$$CJ^XLFSTR(YSTITLE,79," "),!
10 D PT G END:$G(YSDFN)<1
11 D NX,PREV
12 D OPT1 Q:$D(DIRUT)
13 D ADMIN:YSOPT="A",PRINT:YSOPT="P",CLERK:YSOPT="C"
14 ;
15 G MAIN
16ADMIN ;
17 K J
18 I $D(^YTD(601.4,YSDFN,1,YSENTRY)) G RESTART
19 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
20 S YSORD=+Y
21 S YSQ=0 D A31^YTCLERK1 I YSOK<1 D KAR^YTS Q
22 I YSQ S ZTIO=ION D HOME^%ZIS
23 S YSTEST=YSENTRY,YSXT=YSENTRY,YSXTP=1
24 D A4^YTAR
25 Q
26RESTART ;
27 K DIR S DIR(0)="S^R:Restart "_YSCODE_";D:Delete previous incomplete and adminster;Q:Quit"
28 D ^DIR K DIR
29 Q:$D(DIRUT)!(Y="Q")
30 I Y="D" S YSTEST=YSENTRY D KT,ADMIN Q
31 S YSTEST=YSENTRY
32 S YTLM=$P($G(^YSA(602,1,0)),U,3) S:YTLM="" YTLM=3
33 I $P($G(^YTT(601,YSTEST,0)),U,16) S YTLM=$P(^(0),U,16)
34 S X2=$S($P(^YTD(601.4,YSDFN,1,YSTEST,0),U,8):$P(^(0),U,8),1:$P(^(0),U,2))
35 S X=$$FMDIFF^XLFDT(DT,X2,1)
36 I X>YTLM W !,"Administration discontinued more than "_YTLM_" days ago -- not restartable" H 2 Q
37 S YSTEST=YSENTRY
38 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)
39 I $D(^YTD(601.4,YSDFN,1,YSENTRY,"B"))#2 S B=^("B")
40 S YSRP=$S(J#200=1:"",1:^YTD(601.4,YSDFN,1,YSENTRY,J+198\200)) S:'J J=1
41 S YSXT=YSTEST_"^" S:$D(^YTD(601.4,YSDFN,1,YSENTRY,"R")) YSXT=YSXT_^("R") S YSXTP=1,YSDEMO="N",YSRESTRT=1
42 S YSQ=0 D A31^YTCLERK1 I YSOK<1 D KAR^YTS Q
43 I YSQ S ZTIO=ION D HOME^%ZIS
44 D A4^YTAR
45 Q
46PRINT ;
47 S YSXT=""
48 W !
49 D DU^YTDP
50 Q
51CLERK ;
52 S YSCL=1,(YTESTN,YSTESTN)=YSCODE,YSCLERK=14,YSENT=14,YSTEST=YSENTRY,YSNQ=$P(^YTT(601,YSENTRY,0),U,11)
53 I $D(^YTD(601.4,YSDFN,1,"AC",YSENTRY)) W !!,"Discontinued CLERK test found:" G RESTART^YTCLERK1
54 I $D(^YTD(601.4,YSDFN)) S DIK="^YTD(601.4,",DA=YSDFN D ^DIK K DIK
55 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
56 S YSORD=+Y
57 S YSQ=0 D A31^YTCLERK1 I YSOK<1 D KAR^YTS Q
58 S (J,YSXTP)=1,(B,C,YSRP)=""
59 D REY1^YTCLERK
60 Q
61PT ;
62 D ^YSLRP G:YSDFN<1 END D ENPT^YSUTL
63 I YSSEX="" W !,"Gender not poperly specified. Call IRM" H 3 G MAIN
64 Q
65OPT1 ;admin, clerk, print
66 W !
67 K DIR
68 S DIR(0)="S^A:Administer on-line;C:Clerk entry"
69 S:YSPREV DIR(0)=DIR(0)_";P:Print"
70 S DIR("A")=$S(YSPREV:"Administer on-line, Clerk entry or Print",1:"Administer on-line or Clerk entry")
71 D ^DIR
72 S YSOPT=Y
73 K DIR
74 G MAIN:$D(DIRUT)
75 Q
76NX ;
77 K A,A1
78 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")
79 S YSSX=YSSEX,YSBL=" ",YSHDR=YSSSN_" "_YSNM_YSBL_YSBL_YSBL,YSHDR=$E(YSHDR,1,44)_YSSX_" AGE "_YSAGE,YSHD=DT
80 S YSHDT=""
81 I '$D(^YTD(601.2,YSDFN,1,YSENTRY)) K A,A1 Q
82 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
83 Q
84PREV ;
85 W @IOF,YSHDR
86 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
87 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
88 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
89 ;
90 W !!,"Previous Administrations of the",$S(YSTITLE["*":$TR(YSTITLE,"*",""),YSTITLE["-":$TR(YSTITLE,"-",""),1:" "_YSTITLE),!!
91 F I=1:1 Q:'$D(A1(I)) D
92 . S YSPREV=I
93 . S Y=$P(A1(I),U,2)
94 . X ^DD("DD")
95 . W:$X>60 !
96 . W $J(I,3)_" "_Y_" "
97 Q
98KT ;
99 K J I $D(^YTD(601.4,YSDFN,1,YSTEST)) S YSENTRY=YSTEST D ENKIL^YTFILE
100 Q
101SF36 ;
102 S YSCODE="SF36" G MAIN
103 ;
104END ;
105 D KVAR^VADPT
106 K %,%Y,A,A1,B,C,I,J,N2,T1,X,X2,Y,YSAGE,YSBEGIN,YSBL,YSCL,YSCLERK
107 K YSCODE,YSDEMO,YSDFN,YSDT,YSENT,YSENTRY,YSHD,YSHDR,YSHDT,YSNM,YSNQ
108 K YSNT,YSOK,YSOPT,YSORD,YSPREV,YSPTD,YSPTM,YSQ,YSRESTRT,YSRP,YSSEX
109 K YSSSN,YSSX,YSTEST,YSTESTN,YSTITLE,YSXT,YSXTP,YTESTN,YTLM
110 Q
Note: See TracBrowser for help on using the repository browser.