YSCEN32 ;ALB/ASF-DRG ;4/4/90  12:47 ;
 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
 ;
 ;  Called from routines YSCEN3, YSCEN34, YSCEN52
 ;
 S:'$D(YSDRGFL) YSDRGFL=0 S:'$D(PTF) PTF=0 D ENPT^YSUTL S AGE=YSAGE,DFN=YSDFN,SEX=YSSEX
 D OA:'J1 Q:'J1  ;S PTF=$S(PTF:J1,1:$P(^DPT(DFN,"DA",+J1,0),U,12)) S:PTF'?1N.N PTF=0
 S B(70)=$G(^DGPT(PTF,70)),ICDDMS=$P(B(70),U,3)=4,ICDEXP=0,SEX=$P(^DPT(DFN,0),U,2),ICDTRS=$P(B(70),U,3)=5 I $D(^DPT(DFN,.35)) S:$L(^DPT(DFN,.35)) ICDEXP=1
 S L8=0 S:$D(^DGPT(PTF,"M",1,0)) L8=$P(^DGPT(PTF,"M",1,0),U,5)
 I $P(B(70),U,10)>0 S L=$P(B(70),U,10),L7="p" G GRP
 I L8>0 S L=L8,L7="m" G GRP
 D PDX^YSCEN6 I 'YSPDX W "  No diagnosis on file" Q
 S L=$O(^ICD9("BA",+YSPDX(3),0)),L7=$S(YSPDX(4)["ICD":"i",1:"d")
 I L'>0 W " ERROR" Q
GRP ;
 S ICDDX(1)=L,ICDPRC="" D ^ICDDRG S YSDRG=ICDDRG Q
OA ;
 S YSINDT=$P(^YSG("INP",YSN,0),U,3) Q:YSINDT'?7N.E  S VAINDT=YSINDT D INP^VADPT S J1=VAIN(10)
KINP ;
 K YSDPT,YSINDT,YS1,ICDDMS,ICDEXP,ICDTRS,ICDDRG,ICDDX,ICDPRC,L,L7 Q
 Q