YTMMPI2C ;DALISC/LJA - Show Comments ;11/09/93 10:37
;;5.01;MENTAL HEALTH;**187**;Dec 30, 1994;Build 73
;
COMM ; YSDFN,YSET,YSED -- req
QUIT:'($G(YSDFN)*$G(YSET)*$G(YSED)) ;->
QUIT:$O(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",0))'>0 ;->
;
; Comment's 0 NODE, AUTHOR, DATE, IEN, LINE NO, TEXT OF LINE,
; NO OF LINES, TRANSCRIBER
N YTC0,YTCA,YTCDT,YTCIEN,YTCLNO,YTCLTXT,YTNL,YTCT
N YTOK,YTX
;
; Display of ITEM RESPONSES just completed...
F QUIT:(IOSL-$Y)<3 W !
I IOST["C-" D QUIT:'YTOK ;->
. S YTOK=1
. K DIR S DIR(0)="EA"
. S DIR("A")="Hit RETURN to view Clinician Comments, or '^' to exit... "
. D ^DIR K DIR
. I +Y'=1 S YTOK=0
W @IOF,?35,"Clinician Comments",!
S X="",$P(X,"-",IOM+1)="" W X,!
;
LOOP S YTCIEN=0,YTOK=1
F S YTCIEN=$O(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",YTCIEN)) QUIT:YTCIEN'>0!('YTOK) D
. S YTC0=$G(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,0))
. QUIT:YTC0']"" ;->
.
. ; Date of comment
. S Y=$P(YTC0,U,2)\1 S Y=$S(Y?7N:Y,1:"") D:Y?7N DD^%DT S YTCDT=Y
.
. ; Transcriber
. S X=+$P(YTC0,U,3),YTCT=$S(X>0:X,1:"")
. I YTCT>0 D
. . S DA=+YTCT,DR=.01,DIQ="YTX",DIQ(0)="E",DIC="^VA(200,"
. . K YTX D EN^DIQ1
. . S YTCT=$G(YTX(200,+DA,.01,"E"))
.
. ; Author
. S X=+$P(YTC0,U,4),YTCA=$S(X>0:X,1:"")
. I YTCA>0 D
. . S DA=+YTCA,DR=.01,DIQ="YTX",DIQ(0)="E",DIC="^VA(200,"
. . K YTX D EN^DIQ1
. . S YTCA=$G(YTX(200,+DA,.01,"E"))
.
. ; Number of Lines of comment...
. S YTNL=+$P($G(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,1,0)),U,4)
.
. ; Loop thru lines of text, displaying them...
. S YTCLNO=0 K YTCLTXT
. F S YTCLNO=$O(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,1,YTCLNO)) QUIT:YTCLNO'>0!('YTOK) D
. . D COMMHEAD:'$D(YTCLTXT)
. . S YTCLTXT=$G(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,1,+YTCLNO,0))
. . D CKPOS QUIT:'YTOK ;->
. . W YTCLTXT,!
QUIT:'YTOK ;--> User must have entered an up-arrow...
D COMMBT
I IOST["C-" D WAIT
QUIT
;
CKPOS ;
; Check position on page
I (IOSL-$Y)>5 QUIT ;->
D COMMBT
I IOST["C-" D WAIT QUIT:'YTOK ;->
W @IOF,?29,"Clinician Comments continued...",!
S X="",$P(X,"-",IOM+1)="" W X,! K X
QUIT
;
WAIT ;
; Added 5/6/94 LJA
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
N N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
N V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
;
S YTOK=0
I IOST'["C-" S YTOK=1 QUIT ;->
F QUIT:(IOSL-$Y)<4 W !
N DIR
K DIR S DIR(0)="EA",DIR("A")="Hit RETURN to continue, or '^' to exit... "
D ^DIR
QUIT:+Y'=1 ;->
S YTOK=1
QUIT
;
COMMBT ;
F QUIT:(IOSL-$Y)<4 W !
S X="",$P(X,"-",IOM+1)="" W X,!
W $$MASKSSN(YSSSN),?20,YSNM,?55,YSSEX,$S(YSSEX="F":"emale",1:"ale"),?70,"Age: ",YSAGE
QUIT
;
COMMHEAD ;
W:$Y>1 !
W YTCDT,?15,"Author: ",$E(YTCA,1,20),?45,"Transcriber: ",$E(YTCT,1,20),!
QUIT
;
MASKSSN(YSSSN) ; return only last 4 of SSN
Q "xxx-xx-"_$E(YSSSN,$L(YSSSN)-3,$L(YSSSN))
;
EOR ;YTMMPI2C - Show Comments ;11/8/93 15:40
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMMPI2C 3092 printed Dec 13, 2024@02:17:49 Page 2
YTMMPI2C ;DALISC/LJA - Show Comments ;11/09/93 10:37
+1 ;;5.01;MENTAL HEALTH;**187**;Dec 30, 1994;Build 73
+2 ;
COMM ; YSDFN,YSET,YSED -- req
+1 ;->
if '($GET(YSDFN)*$GET(YSET)*$GET(YSED))
QUIT
+2 ;->
if $ORDER(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",0))'>0
QUIT
+3 ;
+4 ; Comment's 0 NODE, AUTHOR, DATE, IEN, LINE NO, TEXT OF LINE,
+5 ; NO OF LINES, TRANSCRIBER
+6 NEW YTC0,YTCA,YTCDT,YTCIEN,YTCLNO,YTCLTXT,YTNL,YTCT
+7 NEW YTOK,YTX
+8 ;
+9 ; Display of ITEM RESPONSES just completed...
+10 FOR
if (IOSL-$Y)<3
QUIT
WRITE !
+11 ;->
IF IOST["C-"
Begin DoDot:1
+12 SET YTOK=1
+13 KILL DIR
SET DIR(0)="EA"
+14 SET DIR("A")="Hit RETURN to view Clinician Comments, or '^' to exit... "
+15 DO ^DIR
KILL DIR
+16 IF +Y'=1
SET YTOK=0
End DoDot:1
if 'YTOK
QUIT
+17 WRITE @IOF,?35,"Clinician Comments",!
+18 SET X=""
SET $PIECE(X,"-",IOM+1)=""
WRITE X,!
+19 ;
LOOP SET YTCIEN=0
SET YTOK=1
+1 FOR
SET YTCIEN=$ORDER(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",YTCIEN))
if YTCIEN'>0!('YTOK)
QUIT
Begin DoDot:1
+2 SET YTC0=$GET(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,0))
+3 ;->
if YTC0']""
QUIT
+4 +5 ; Date of comment
+6 SET Y=$PIECE(YTC0,U,2)\1
SET Y=$SELECT(Y?7N:Y,1:"")
if Y?7N
DO DD^%DT
SET YTCDT=Y
+7 +8 ; Transcriber
+9 SET X=+$PIECE(YTC0,U,3)
SET YTCT=$SELECT(X>0:X,1:"")
+10 IF YTCT>0
Begin DoDot:2
+11 SET DA=+YTCT
SET DR=.01
SET DIQ="YTX"
SET DIQ(0)="E"
SET DIC="^VA(200,"
+12 KILL YTX
DO EN^DIQ1
+13 SET YTCT=$GET(YTX(200,+DA,.01,"E"))
End DoDot:2
+14 +15 ; Author
+16 SET X=+$PIECE(YTC0,U,4)
SET YTCA=$SELECT(X>0:X,1:"")
+17 IF YTCA>0
Begin DoDot:2
+18 SET DA=+YTCA
SET DR=.01
SET DIQ="YTX"
SET DIQ(0)="E"
SET DIC="^VA(200,"
+19 KILL YTX
DO EN^DIQ1
+20 SET YTCA=$GET(YTX(200,+DA,.01,"E"))
End DoDot:2
+21 +22 ; Number of Lines of comment...
+23 SET YTNL=+$PIECE($GET(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,1,0)),U,4)
+24 +25 ; Loop thru lines of text, displaying them...
+26 SET YTCLNO=0
KILL YTCLTXT
+27 FOR
SET YTCLNO=$ORDER(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,1,YTCLNO))
if YTCLNO'>0!('YTOK)
QUIT
Begin DoDot:2
+28 if '$DATA(YTCLTXT)
DO COMMHEAD
+29 SET YTCLTXT=$GET(^YTD(601.2,+YSDFN,1,+YSET,1,+YSED,"R",+YTCIEN,1,+YTCLNO,0))
+30 ;->
DO CKPOS
if 'YTOK
QUIT
+31 WRITE YTCLTXT,!
End DoDot:2
End DoDot:1
+32 ;--> User must have entered an up-arrow...
if 'YTOK
QUIT
+33 DO COMMBT
+34 IF IOST["C-"
DO WAIT
+35 QUIT
+36 ;
CKPOS ;
+1 ; Check position on page
+2 ;->
IF (IOSL-$Y)>5
QUIT
+3 DO COMMBT
+4 ;->
IF IOST["C-"
DO WAIT
if 'YTOK
QUIT
+5 WRITE @IOF,?29,"Clinician Comments continued...",!
+6 SET X=""
SET $PIECE(X,"-",IOM+1)=""
WRITE X,!
KILL X
+7 QUIT
+8 ;
WAIT ;
+1 ; Added 5/6/94 LJA
+2 NEW A,B,B1,C,D,E,E1,F,F1,G,G1,H,I,J,J1,J2,J3,J4,K,L,L1,L2,M,N
+3 NEW N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
+4 NEW V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
+5 ;
+6 SET YTOK=0
+7 ;->
IF IOST'["C-"
SET YTOK=1
QUIT
+8 FOR
if (IOSL-$Y)<4
QUIT
WRITE !
+9 NEW DIR
+10 KILL DIR
SET DIR(0)="EA"
SET DIR("A")="Hit RETURN to continue, or '^' to exit... "
+11 DO ^DIR
+12 ;->
if +Y'=1
QUIT
+13 SET YTOK=1
+14 QUIT
+15 ;
COMMBT ;
+1 FOR
if (IOSL-$Y)<4
QUIT
WRITE !
+2 SET X=""
SET $PIECE(X,"-",IOM+1)=""
WRITE X,!
+3 WRITE $$MASKSSN(YSSSN),?20,YSNM,?55,YSSEX,$SELECT(YSSEX="F":"emale",1:"ale"),?70,"Age: ",YSAGE
+4 QUIT
+5 ;
COMMHEAD ;
+1 if $Y>1
WRITE !
+2 WRITE YTCDT,?15,"Author: ",$EXTRACT(YTCA,1,20),?45,"Transcriber: ",$EXTRACT(YTCT,1,20),!
+3 QUIT
+4 ;
MASKSSN(YSSSN) ; return only last 4 of SSN
+1 QUIT "xxx-xx-"_$EXTRACT(YSSSN,$LENGTH(YSSSN)-3,$LENGTH(YSSSN))
+2 ;
EOR ;YTMMPI2C - Show Comments ;11/8/93 15:40
