source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMPI2C.m@ 1638

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1YTMMPI2C ;DALISC/LJA - Show Comments ;11/09/93 10:37
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4COMM ; YSDFN,YSET,YSED -- req
5 QUIT:'($G(YSDFN)*$G(YSET)*$G(YSED)) ;->
6 QUIT:$O(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",0))'>0 ;->
7 ;
8 ; Comment's 0 NODE, AUTHOR, DATE, IEN, LINE NO, TEXT OF LINE,
9 ; NO OF LINES, TRANSCRIBER
10 N YTC0,YTCA,YTCDT,YTCIEN,YTCLNO,YTCLTXT,YTNL,YTCT
11 N YTOK,YTX
12 ;
13 ; Display of ITEM RESPONSES just completed...
14 F QUIT:(IOSL-$Y)<3 W !
15 I IOST["C-" D QUIT:'YTOK ;->
16 . S YTOK=1
17 . K DIR S DIR(0)="EA"
18 . S DIR("A")="Hit RETURN to view Clinician Comments, or '^' to exit... "
19 . D ^DIR K DIR
20 . I +Y'=1 S YTOK=0
21 W @IOF,?35,"Clinician Comments",!
22 S X="",$P(X,"-",IOM+1)="" W X,!
23 ;
24LOOP S YTCIEN=0,YTOK=1
25 F S YTCIEN=$O(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",YTCIEN)) QUIT:YTCIEN'>0!('YTOK) D
26 . S YTC0=$G(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,0))
27 . QUIT:YTC0']"" ;->
28 .
29 . ; Date of comment
30 . S Y=$P(YTC0,U,2)\1 S Y=$S(Y?7N:Y,1:"") D:Y?7N DD^%DT S YTCDT=Y
31 .
32 . ; Transcriber
33 . S X=+$P(YTC0,U,3),YTCT=$S(X>0:X,1:"")
34 . I YTCT>0 D
35 . . S DA=+YTCT,DR=.01,DIQ="YTX",DIQ(0)="E",DIC="^VA(200,"
36 . . K YTX D EN^DIQ1
37 . . S YTCT=$G(YTX(200,+DA,.01,"E"))
38 .
39 . ; Author
40 . S X=+$P(YTC0,U,4),YTCA=$S(X>0:X,1:"")
41 . I YTCA>0 D
42 . . S DA=+YTCA,DR=.01,DIQ="YTX",DIQ(0)="E",DIC="^VA(200,"
43 . . K YTX D EN^DIQ1
44 . . S YTCA=$G(YTX(200,+DA,.01,"E"))
45 .
46 . ; Number of Lines of comment...
47 . S YTNL=+$P($G(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,1,0)),U,4)
48 .
49 . ; Loop thru lines of text, displaying them...
50 . S YTCLNO=0 K YTCLTXT
51 . F S YTCLNO=$O(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,1,YTCLNO)) QUIT:YTCLNO'>0!('YTOK) D
52 . . D COMMHEAD:'$D(YTCLTXT)
53 . . S YTCLTXT=$G(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,1,+YTCLNO,0))
54 . . D CKPOS QUIT:'YTOK ;->
55 . . W YTCLTXT,!
56 QUIT:'YTOK ;--> User must have entered an up-arrow...
57 D COMMBT
58 I IOST["C-" D WAIT
59 QUIT
60 ;
61CKPOS ;
62 ; Check position on page
63 I (IOSL-$Y)>5 QUIT ;->
64 D COMMBT
65 I IOST["C-" D WAIT QUIT:'YTOK ;->
66 W @IOF,?29,"Clinician Comments continued...",!
67 S X="",$P(X,"-",IOM+1)="" W X,! K X
68 QUIT
69 ;
70WAIT ;
71 ; Added 5/6/94 LJA
72 N A,B,B1,C,D,E,E1,F,F1,G,G1,H,I,J,J1,J2,J3,J4,K,L,L1,L2,M,N
73 N N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
74 N V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
75 ;
76 S YTOK=0
77 I IOST'["C-" S YTOK=1 QUIT ;->
78 F QUIT:(IOSL-$Y)<4 W !
79 N DIR
80 K DIR S DIR(0)="EA",DIR("A")="Hit RETURN to continue, or '^' to exit... "
81 D ^DIR
82 QUIT:+Y'=1 ;->
83 S YTOK=1
84 QUIT
85 ;
86COMMBT ;
87 F QUIT:(IOSL-$Y)<4 W !
88 S X="",$P(X,"-",IOM+1)="" W X,!
89 W YSSSN,?20,YSNM,?55,YSSEX,$S(YSSEX="F":"emale",1:"ale"),?70,"Age: ",YSAGE
90 QUIT
91 ;
92COMMHEAD ;
93 W:$Y>1 !
94 W YTCDT,?15,"Author: ",$E(YTCA,1,20),?45,"Transcriber: ",$E(YTCT,1,20),!
95 QUIT
96 ;
97EOR ;YTMMPI2C - Show Comments ;11/8/93 15:40
Note: See TracBrowser for help on using the repository browser.