| 1 | YTEXT ;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
|
|---|
| 8 | 1 ;
|
|---|
| 9 | W ! D ^YSLRP I YSDFN'>0 D END Q
|
|---|
| 10 | 2 ;
|
|---|
| 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)
|
|---|
| 14 | 3 ;
|
|---|
| 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)
|
|---|
| 16 | I ;
|
|---|
| 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
|
|---|
| 22 | D ;
|
|---|
| 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
|
|---|
| 24 | DR ;
|
|---|
| 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
|
|---|
| 28 | LU ;
|
|---|
| 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
|
|---|
| 33 | A ;
|
|---|
| 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
|
|---|
| 39 | E ;
|
|---|
| 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)
|
|---|
| 43 | E0 ;
|
|---|
| 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
|
|---|
| 46 | E1 ;
|
|---|
| 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
|
|---|
| 53 | E2 ;
|
|---|
| 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)
|
|---|
| 56 | E3 ;
|
|---|
| 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
|
|---|
| 61 | OUT ;
|
|---|
| 62 | S YSLFT=1 Q
|
|---|
| 63 | END ;
|
|---|
| 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
|
|---|
| 66 | LU1 ;
|
|---|
| 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
|
|---|
| 72 | DAT(X) ;
|
|---|
| 73 | S X=$$FMTE^XLFDT(X,"5ZD") Q X
|
|---|
| 74 | CK ;
|
|---|
| 75 | S:YSP0 YSCON=1 D ENFT^YSFORM:YSP0,WAIT^YSUTL:'YSP0 Q:YSLFT D:YSP0 ENHD^YSFORM Q
|
|---|
| 76 | DEL ;
|
|---|
| 77 | S DA=YSDN,DIK=DIC D ^DIK W !!,"No comment filed" S YSLFT=1 Q
|
|---|
| 78 | S ;
|
|---|
| 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
|
|---|
