source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YIHISTF.m@ 701

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1YIHISTF ;SLC/DKG-INTERVIEW HISTORY DRIVER (Cont) ; 10/18/88 13:40 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3CK ;
4 Q:'$T
5CK1 ;
6 S:P0 YSCON=1 D WAIT:'P0,ENFT^YSFORM:P0 Q:YSLFT D HDR:P0 Q
7L ;
8 S Y1=$E(YSYTX,1,78-YSIND),Y2=$E(YSYTX,79-YSIND,255)
9 I Y2="" X P1 D CK Q:YSLFT W !?YSIND,Y1 Q
10 F YSYI=78-YSIND:-1:1 I $E(Y1,YSYI)?1P X P1 D CK Q:YSLFT W !?YSIND,$E(Y1,1,YSYI) S YSYTX=$E(Y1,YSYI+1,78-YSIND)_Y2 Q
11 I $E(Y1,YSYI)'?1P X P1 D CK Q:YSLFT W !?YSIND,Y1 S YSYTX=Y2
12 G L
13 ;
14RP ;
15 S J=1,U1=0,L=-200,YSLCK=200,YSFHDR=$P(^YTT(601,YSTEST,"P"),U,4),YSCON=0,YSFTR=$P(^YTT(601,YSTEST,"P"),U,5),YSLFT=0,YSFORM=1,YSXR="Patient Report"
16 S P1=$S(IOST?1"C-".E:"I IOSL-$Y<3",1:"I IOSL-$Y<7"),P3=$S(P1[3:"I IOSL-$Y<6",1:"I IOSL-$Y<10"),P0=$S(P1[3:0,1:1) D HDR
17R1 ;
18 I '$D(^YTT(601,YSTEST,"G",J,1,1,0)) D PC,ENFT^YSFORM:P0 K A,B,D,DIW,DIWF,DIWL,DIWR,DIWT,DN,DW2,DWI,I,YSI,YSJ,YSU,YSXR,YSIND,J,L,YSLCK,R,YSSTEM,U1,YSYX,YSYCK,YSSCK Q
19 S A=^YTT(601,YSTEST,"G",J,1,1,0),J=J+1,B=$P(A,U),I=+B,YSIND=$P(B,",",2)
20 I I=0 G:$P(A,U,3)="OMIT" R1 X P3 D CK G:YSLFT END W !!?YSIND,$P(A,U,2),! S YSLCK=200 G R1
21 I I'>L!(I>U1) S L=(I-1)\200*200,U1=L+200,YSYX=^YTD(601.2,YSDFN,1,YSET,1,YSED,U1\200)
22 S R=$E(YSYX,I-L) G:R=" " R1
23 S YSSTEM=$P(A,U,2) G:YSSTEM'["##" YSRP1 S YSSCK=$S(YSSTEM["2":2,YSSTEM["1":1,1:0) I YSSTEM["L" S YSLCK=YSIND,YSYCK=$P(A,U,3) G R1
24 I YSSCK X P3 D CK G:YSLFT END
25 W:YSSCK ! W !?YSIND,$P(A,U,3) W:YSSCK=2 ! G R1
26YSRP1 ;
27 I "YN"[R S R=R="N"+1 I YSSTEM'["#" S R=$P(A,U,R+1) G NOST:R'="",R1
28 S R=$P(A,U,R+2) G R1:R="",NOST:YSSTEM=""
29 D:YSIND>YSLCK STM G:YSLFT END
30 I YSSTEM'["#" S YSYTX=YSSTEM_R D L G R1:'YSLFT,END
31 S A=$F(YSSTEM,"#") I A<3 S YSYTX=R_$E(YSSTEM,2,99) D L G R1:'YSLFT,END
32 S YSYTX=$E(YSSTEM,1,A-2)_R_$E(YSSTEM,A,99) D L G R1:'YSLFT,END
33NOST ;
34 D:YSIND>YSLCK STM G:YSLFT END S YSYTX=R D L G R1:'YSLFT,END
35STM ;
36 I YSSCK X P3 D CK Q:YSLFT
37 W:YSSCK ! W !?YSLCK,YSYCK W:YSSCK=2 ! S YSLCK=200 Q
38WH ;
39 W !,$P(^YTT(601,YSTEST,0),U)," QUESTION # ",J,! H 2 G @(R1)
40HDR ;
41 W @IOF I P0 W ! F I=1:1:80 W "-"
42 I P0 W !,"MEDICAL RECORD"
43 W ?(80-$L(YSFHDR)/2),YSFHDR I P0 W ! F I=1:1:80 W "-"
44 I YSCON W !?25,"(Continued from previous page)" S YSCON=0
45 W !?(80-$L(YSXR)\2),YSXR,":" Q
46WAIT ;
47 F I0=1:1:IOSL-$Y-2 W !
48 N DTOUT,DUOUT,DIRUT
49 S DIR(0)="E" D ^DIR K DIR S YSLFT=$D(DIRUT) W @IOF
50 Q
51END ;
52 K P0,P1,P3,YSFHDR,YSCON,YSFTR,A,B,I,J,L,YSIND,YSLCK,R,YSSTEM,YSYX,YSYCK,YSSCK,Y1,Y2,YSYI,YSYTX Q
53PC ;
54 S YSXR="Staff Report" I $Y+$S(P0:10,1:5)>IOSL D CK1 Q:YSLFT
55 E W !!?34,YSXR
56 S YSI=0 F S YSI=$O(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R","AD",YSI)) Q:'YSI Q:YSLFT S YSJ=0 F S YSJ=$O(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R","AD",YSI,YSJ)) Q:'YSJ Q:'$D(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSJ,0)) S X=^(0) D PC1 Q:YSLFT
57 K D,DIW,DIWF,DIWL,DIWR,DIWT,DN,DW2,DWI,I,YSI,YSJ,YSU Q
58PC1 ;
59 S YSU=$P(X,U,4) Q:YSU<1 D:$Y+$S(P0:11,1:6)>IOSL CK1 Q:YSLFT
60 S Y=YSI D DD^%DT W !!,Y S DIC="^YTD(601.2,YSDFN,1,YSET,1,YSED,""R"",YSJ,1,",DIWL=1,DIWR=80,DIWF="W",DWI="F D=1:1:DW2 S X="_DIC_"D,0) D:$Y+$S(P0:12,1:7)>IOSL CK1 Q:YSLFT D ^DIWP"
61 S Z=DIC_"0)",DW2=$P(@(Z),U,4) D:$Y+$S(P0:10,1:5)>IOSL CK1 Q:YSLFT W !! X DWI Q:YSLFT D:$Y+$S(P0:11,1:5)>IOSL CK1 D ^DIWW D:$Y+$S(P0:10,1:4)>IOSL CK1 Q:YSLFT W ! W:P0 !! W $P($G(^VA(200,+YSU,0)),U)
62 I P0 W !,"NOT VALID UNLESS SIGNED - NOT TO BE FILED IN MEDICAL RECORD UNLESS SIGNED" Q
Note: See TracBrowser for help on using the repository browser.