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