source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTEXT.m@ 1710

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

initial load of WorldVistAEHR

File size: 4.4 KB
RevLine 
[613]1YTEXT ;SLC/TGA-TEXT I/O FOR STAFF REMARKS ; 7/6/89 13:55 ;03/11/94 14:26
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4 ; Called from the top by MENU option YSCOMMENT
5 ;
6 W @IOF,!!,"Staff Comments - Tests and Interviews"
7 I '$D(YSDT(0)) K Y D ENDD^YSUTL
81 ;
9 W ! D ^YSLRP I YSDFN'>0 D END Q
102 ;
11 K A,A1 ; 3/11/94 LJA - Clear variable "leftovers"...
12 D NX1^YTS I YSNT<1 W !!,"No completed instruments found" G 1
13 W !!?10,"--- Previous Instruments ---",! S B=$S(YSNT<11:YSNT,1:YSNT+1\2)
143 ;
15 F K=1:1:B S YSDT=$P(A1(K),U,2) W !?10,K,?15,$P(A1(K),U),?22,$$DAT(YSDT) I B'=YSNT,$D(A1(B+K)) W ?45,B+K,?50,$P(A1(B+K),U) S YSDT=$P(A1(B+K),U,2) W ?57,$$DAT(YSDT)
16I ;
17 S DIR(0)="NO^1:"_YSNT_":0",DIR("A")="Select Instrument Number"
18 W !! D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
19 G 1:YSUOUT!'Y,END:YSTOUT S YSTEST=Y
20 I '$D(A1(YSTEST)) W:YSTEST'["?" " ?",$C(7) G I
21 S X=$P(A1(YSTEST),U,3) I '$D(^XUSEC("YSP",DUZ)),$P(^YTT(601,X,0),U,9)="T",$P(^(0),U,10)'="Y" S YSEC=1 G LU ;DISPLAY SECURITY CK
22D ;
23 R !!,"Shall I display the results now? N// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G END:YSTOUT S A=$TR($E(A_"N"),"yn","YN") G 3:YSUOUT,LU:"N"[A,DR:"Y"[A W:A'["?" $C(7)," ?" W !,"Answer 'Yes' or 'No'" G D
24DR ;
25 S YSXT=$P(A1(YSTEST),U,2)_","_$P(A1(YSTEST),U,3),YSHDR=YSSSN_" "_YSNM,YSSX=YSSEX,^UTILITY($J)=YSDFN_U_A1(YSTEST) F I=1:1:43 Q:$L(YSHDR)>42 S YSHDR=YSHDR_" "
26 ;D RP^YTDP G:YSTXTED!POP END S X=^UTILITY($J),YSDFN=$P(X,U),YSTEST=$P(X,U,4),A1(YSTEST)=$P(X,U,2,4) D ENPT^YSUTL
27 D RP^YTDP G:YSTOUT!POP END S X=^UTILITY($J),YSDFN=$P(X,U),YSTEST=$P(X,U,4),A1(YSTEST)=$P(X,U,2,4) D ENPT^YSUTL
28LU ;
29 S (YSP1,YSP2)=0,YSET=$P(A1(YSTEST),U,3),YSED=$P(A1(YSTEST),U,2),YSLFT=0
30 I $G(YSEC) D E G:YSLFT END G 2
31 S I=0 F S I=$O(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",I)) Q:'I S X=^(I,0) D LU1
32 I YSP1<1,YSP2<1 D E G:YSLFT END G LU
33A ;
34 S X="Ee"_$S(YSP1:"Pp",1:"")_$S(YSP2:"Ss",1:"")
35 W !!,"(E)nter" W:YSP1 " or (P)rint" W:YSP2 " or (S)ign" W " comments: " R A:DTIME S YSTOUT='$T,YSUOUT=A["^" I YSTOUT G END
36 I YSUOUT!(A']"") G 2
37 S A=$E(A) I X'[A W:A'["?" " ?",$C(7) W !!,"Type 'E'" W:YSP1 " or 'P'" W:YSP2 " or 'S'" G A
38 S:"Pp"[A A="^YTEXT1" S:"Ee"[A A="E" D @A G:YSLFT END G LU
39E ;
40 N A,A1
41 S:'$D(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",0)) ^(0)="^601.2213D^^" S DIC="^YTD(601.2,YSDFN,1,YSET,1,YSED,""R"",",DIC(0)="L",DLAYGO=601,X="T" D ^DIC G:Y<1 OUT S YSDN=+Y
42 S DIE=DIC,DA=+Y,DR="1//TODAY;2///`"_DUZ_";3;9",DA(3)=YSDFN,DA(2)=YSET,DA(1)=YSED L +^YTD(601.2,YSDFN) D ^DIE L -^YTD(601.2,YSDFN) S YSTOUT=$D(DTOUT)
43E0 ;
44 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSDN,0) F I=2:1:4 I '$P(X,U,I) D DEL Q
45 Q:'$D(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSDN)) I '$D(^(YSDN,1,1,0)) D DEL Q
46E1 ;
47 ; commented out lines represent electronic signature on
48 ; comments added to MH insturments the file structure is present to
49 ; support this but the EP does not want it in place at this time 5.0, 1992
50 ;W !!,"Comment will be sealed upon signing."
51 R !,"Do you wish to review comment prior to filing? N// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G OUT:YSTOUT!YSUOUT S A=$E(A) G E2:"Nn"[A I "Yy"'[A W:A'["?" " ?",$C(7) G E1
52 S DR=9 L +^YTD(601.2,YSDFN) D ^DIE L -^YTD(601.2,YSDFN) G E0
53E2 ;
54 ;R !!,"Do you wish to afix your signature to this comment? Y// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G OUT:YSTOUT!YSUOUT S A=$TR($E(A_"Y"),"yn","YN") G E3:"N"[A I "Y"'[A W:A'["?" " ?" G E2
55 ;S DR="4///^S X=1";5///NOW" L +^YTD(601.2,YSDFN) D ^DIE L -^YTD(601.2,YSDFN) Q:$D(DTOUT)
56E3 ;
57 R !!,"File this comment now? Y// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" I YSTOUT!YSUOUT D DEL G OUT
58 S A=$TR($E(A_"Y"),"yn","YN") I "N"[A D DEL G OUT
59 I "Y"'[A W:A'["?" " ?",$C(7) G E3
60 W !!,"Comment filed" Q
61OUT ;
62 S YSLFT=1 Q
63END ;
64 K %,%DT,%ZIS,%Y,A,A1,B,D,D0,DA,DIC,DIE,DIK,DIW,DIWF,DIWL,DIWR,DIWT,DN,DO,DQ,DR,DW2,DWI,I,J,K,N,N1,N2,N4,T2,X,X9,Y,YSAGE,YSCON,YSD,YSDFN,YSDN,YSDOB,YSED,YSES,YSET,YSFHDR,YSFTR,YSHDR,YSHDT
65 K YSI,YSJ,YSLFT,YSN,YSNM,YSNT,YSP0,YSP1,YSP2,YSPF,YSEC,YSSEX,YSSSN,YSTEST,YSTF,YSTX,YSTXTED,YSU,Z,ZTSK,^UTILITY($J) Q
66LU1 ;
67 I DUZ=$P(X,U,4) S YSP1=1 S:'$P(X,U,5) YSP2=1
68 E S:$P(X,U,5) YSP1=1
69 S YSP1=1 ;ENABLE PRINT WITHOUT ELECTRONIC SIGNATURE
70 S YSP2=0 ;DISABLE ELECTRONIC SIGNATURE
71 Q
72DAT(X) ;
73 S X=$$FMTE^XLFDT(X,"5ZD") Q X
74CK ;
75 S:YSP0 YSCON=1 D ENFT^YSFORM:YSP0,WAIT^YSUTL:'YSP0 Q:YSLFT D:YSP0 ENHD^YSFORM Q
76DEL ;
77 S DA=YSDN,DIK=DIC D ^DIK W !!,"No comment filed" S YSLFT=1 Q
78S ;
79 S DIC="^YTD(601.2,YSDFN,1,YSET,1,YSED,""R"",",DIC(0)="AEQ",DIC("S")="I DUZ=$P(^(0),U,4),$P(^(0),U,5)=""""" D ^DIC K DIC("S") Q:Y'>0 S DA=+Y,YSDN=+Y D E1
Note: See TracBrowser for help on using the repository browser.