22 lines
973 B
Mathematica
22 lines
973 B
Mathematica
|
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
|