YIPHYD ;SLC/DKG-INTERVIEW PHYSICAL PROBLEMS ; 10/18/88 13:41 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) D HDR^YIHIST W !!?18,^YTT(601,YSTEST,"G",1,1,1,0),!!!?22,^YTT(601,YSTEST,"G",2,1,1,0),!
S K=2,YSLC=$Y F I=1,4,6,7,9,10,13,16,19,22,24,28,33,34,37 S K=K+1 W:$E(X,I)="Y" !,^YTT(601,YSTEST,"G",K,1,1,0)
W:YSLC=$Y !,"NONE INDICATED"
I IOST?1"C-".E D WAIT^YSUTL G:YSLFT END
W:IOST?1"P".E !!! W ?22,^YTT(601,YSTEST,"G",18,1,1,0),!
S YSSY="21^50^80^111^171^140^150^201^230^252^291^311^351^381"
S K=18 F YSKK=1:1:14 S K=K+1 D YSSYM
END ;
W ! K A,B,I,K,YSKK,YSLC,YSSY,X Q
YSSYM ;
S A=$P(YSSY,U,YSKK),B=A#10,A=A\10 G:A=15 B3
Q:$E(X,A)'="Y" W !,^YTT(601,YSTEST,"G",K,1,1,0) Q:B=0 G B1:B=1,B2
B2 ;
S A=+$E(X,26) W !,^YTT(601,YSTEST,"G",43+A,1,1,0) S A=26
B1 ;
S A=+$E(X,A+1) W !,^YTT(601,YSTEST,"G",33+A,1,1,0) Q
B3 ;
I $E(X,14)="N",$E(X,17)="N" W !,^YTT(601,YSTEST,"G",K,1,1,0)
W !,^YTT(601,YSTEST,"G",$E(X,15)+36,1,1,0) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYIPHYD 986 printed Oct 16, 2024@18:12:41 Page 2
YIPHYD ;SLC/DKG-INTERVIEW PHYSICAL PROBLEMS ; 10/18/88 13:41 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 SET X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
DO HDR^YIHIST
WRITE !!?18,^YTT(601,YSTEST,"G",1,1,1,0),!!!?22,^YTT(601,YSTEST,"G",2,1,1,0),!
+3 SET K=2
SET YSLC=$Y
FOR I=1,4,6,7,9,10,13,16,19,22,24,28,33,34,37
SET K=K+1
if $EXTRACT(X,I)="Y"
WRITE !,^YTT(601,YSTEST,"G",K,1,1,0)
+4 if YSLC=$Y
WRITE !,"NONE INDICATED"
+5 IF IOST?1"C-".E
DO WAIT^YSUTL
if YSLFT
GOTO END
+6 if IOST?1"P".E
WRITE !!!
WRITE ?22,^YTT(601,YSTEST,"G",18,1,1,0),!
+7 SET YSSY="21^50^80^111^171^140^150^201^230^252^291^311^351^381"
+8 SET K=18
FOR YSKK=1:1:14
SET K=K+1
DO YSSYM
END ;
+1 WRITE !
KILL A,B,I,K,YSKK,YSLC,YSSY,X
QUIT
YSSYM ;
+1 SET A=$PIECE(YSSY,U,YSKK)
SET B=A#10
SET A=A\10
if A=15
GOTO B3
+2 if $EXTRACT(X,A)'="Y"
QUIT
WRITE !,^YTT(601,YSTEST,"G",K,1,1,0)
if B=0
QUIT
if B=1
GOTO B1
GOTO B2
B2 ;
+1 SET A=+$EXTRACT(X,26)
WRITE !,^YTT(601,YSTEST,"G",43+A,1,1,0)
SET A=26
B1 ;
+1 SET A=+$EXTRACT(X,A+1)
WRITE !,^YTT(601,YSTEST,"G",33+A,1,1,0)
QUIT
B3 ;
+1 IF $EXTRACT(X,14)="N"
IF $EXTRACT(X,17)="N"
WRITE !,^YTT(601,YSTEST,"G",K,1,1,0)
+2 WRITE !,^YTT(601,YSTEST,"G",$EXTRACT(X,15)+36,1,1,0)
QUIT
