128 lines
9.6 KiB
Mathematica
128 lines
9.6 KiB
Mathematica
SPNAGGO ;SD/CM- AGGREGATE OUTPATIENT OUTCOMES REPORT; 2-21-2003
|
|
;;2.0;Spinal Cord Dysfunction;**20**;01/02/97
|
|
;
|
|
EN ;
|
|
S U="^"
|
|
D INPT^SPNAGGU
|
|
PARAMS ;
|
|
D CED
|
|
G:SPNLEXIT=1 EXIT
|
|
DEVICE ;
|
|
S ZTSAVE("SPN*")="",ZTSAVE("B*")="",ZTSAVE("AGE*")="",ZTSAVE("MIN*")=""
|
|
S ZTSAVE("MAX*")="",ZTSAVE("LOR*")="",ZTSAVE("TF*")="",ZTSAVE("SEX*")=""
|
|
S ZTSAVE("SL*")="",ZTSAVE("COMD*")="",ZTSAVE("CARETYP")=""
|
|
S ZTSAVE("EDATE")="",ZTSAVE("BDATE")="",ZTSAVE("LINE")="",ZTSAVE("I")=""
|
|
S ZTSAVE("ASIA*")=""
|
|
W !
|
|
D DEVICE^SPNPRTMT("PRINT^SPNAGGPO","Outpt Rehab Outcomes",.ZTSAVE) Q:SPNLEXIT
|
|
I SPNIO="Q" D EXIT Q ; Print was queued
|
|
I IO'="" D PRINT^SPNAGGPO D EXIT Q ; Print was not queued
|
|
D EXIT
|
|
Q
|
|
CED ;date range for Care End Date
|
|
D DATE^SPNAGGA
|
|
Q
|
|
OIEN ;
|
|
S SPNPD1=0 F S SPNPD1=$O(^SPNL(154.1,"B",SPNPD0,SPNPD1)) Q:'+SPNPD1 D DIAGCAT
|
|
Q
|
|
DIAGCAT ;get ASIA Highest Neuro Level and ASIA Imp Scale
|
|
S SPNDCS=0,SPNDCM=0,SPNDCP=0,SPNDCL=0
|
|
Q:'$D(^SPNL(154.1,SPNPD1,0))
|
|
Q:'$D(^SPNL(154.1,SPNPD1,"ASIA"))
|
|
Q:'$D(^SPNL(154.1,SPNPD1,8))
|
|
Q:$P(^SPNL(154.1,SPNPD1,0),U,2)'=3
|
|
Q:$P(^SPNL(154.1,SPNPD1,8),U,3)'=CARETYP
|
|
Q:$P($G(^SPNL(154.1,SPNPD1,8)),U,2)<BDATE!($P($G(^SPNL(154.1,SPNPD1,8)),U,2)>EDATE)
|
|
Q:$P($G(^SPNL(154.1,SPNPD1,0)),U,1)=SPNNODUP
|
|
S SPNNODUP=$P($G(^SPNL(154.1,SPNPD1,0)),U,1)
|
|
I "ABC"[$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,1),$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)<5 S SPNDCS=1
|
|
I "ABC"[$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,1),$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)<5 S SPNLSTDT="S"
|
|
I "ABC"[$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,1)&($P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)>4)&($P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)<9) S SPNDCM=1
|
|
I "ABC"[$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,1)&($P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)>4)&($P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)<9) S SPNLSTDT="M"
|
|
I "ABC"[$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,1),$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)>8 S SPNDCP=1
|
|
I "ABC"[$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,1),$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)>8 S SPNLSTDT="P"
|
|
I $P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,1)="D",$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)<31 S SPNDCL=1
|
|
I $P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,1)="D",$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)<31 S SPNLSTDT="L"
|
|
I SPNLSTDT="S" S SPNSEVC=SPNSEVC+1
|
|
I SPNLSTDT="M" S SPNMODC=SPNMODC+1
|
|
I SPNLSTDT="P" S SPNPARC=SPNPARC+1
|
|
I SPNLSTDT="L" S SPNLOWC=SPNLOWC+1
|
|
S SPNDIAGC=SPNDIAGC+1
|
|
;
|
|
AGE ;
|
|
S AGECALL=$$GET1^DIQ(154.1,SPNPD1,999.025)
|
|
I +SPNDCS S SPNAGES=SPNAGES+AGECALL,AGESC=AGESC+1 S:AGESC=1 BMAS=AGECALL S MINAGES=$S(AGECALL<BMAS:AGECALL,1:BMAS)
|
|
I +SPNDCS S:AGESC=1 BHAS=AGECALL S MAXAGES=$S(AGECALL>BHAS:AGECALL,1:BHAS)
|
|
I +SPNDCM S SPNAGEM=SPNAGEM+AGECALL,AGEMC=AGEMC+1 S:AGEMC=1 BMAM=AGECALL S MINAGEM=$S(AGECALL<BMAM:AGECALL,1:BMAM)
|
|
I +SPNDCM S:AGEMC=1 BHAM=AGECALL S MAXAGEM=$S(AGECALL>BHAM:AGECALL,1:BHAM)
|
|
I +SPNDCP S SPNAGEP=SPNAGEP+AGECALL,AGEPC=AGEPC+1 S:AGEPC=1 BMAP=AGECALL S MINAGEP=$S(AGECALL<BMAP:AGECALL,1:BMAP)
|
|
I +SPNDCP S:AGEPC=1 BHAP=AGECALL S MAXAGEP=$S(AGECALL>BHAP:AGECALL,1:BHAP)
|
|
I +SPNDCL S SPNAGEL=SPNAGEL+AGECALL,AGELC=AGELC+1 S:AGELC=1 BMAL=AGECALL S MINAGEL=$S(AGECALL<BMAL:AGECALL,1:BMAL)
|
|
I +SPNDCL S:AGELC=1 BHAL=AGECALL S MAXAGEL=$S(AGECALL>BHAL:AGECALL,1:BHAL)
|
|
S AGEL=$S((MINAGES<MINAGEM)&(MINAGES<MINAGEP)&(MINAGES<MINAGEL):MINAGES,(MINAGEM<MINAGEP)&(MINAGEM<MINAGEL):MINAGEM,MINAGEP<MINAGEL:MINAGEP,1:MINAGEL)
|
|
S AGEH=$S((MAXAGES>MAXAGEM)&(MAXAGES>MAXAGEP)&(MAXAGES>MAXAGEL):MAXAGES,(MAXAGEM>MAXAGEP)&(MAXAGEM>MAXAGEL):MAXAGEM,MAXAGEP>MAXAGEL:MAXAGEP,1:MAXAGEL)
|
|
;
|
|
SEX ;
|
|
S SEXCALL=$P(^DPT($P(^SPNL(154.1,SPNPD1,0),U,1),0),U,2)
|
|
I +SPNDCS,SEXCALL="M" S SPNSEXS=SPNSEXS+1
|
|
I +SPNDCM,SEXCALL="M" S SPNSEXM=SPNSEXM+1
|
|
I +SPNDCP,SEXCALL="M" S SPNSEXP=SPNSEXP+1
|
|
I +SPNDCL,SEXCALL="M" S SPNSEXL=SPNSEXL+1
|
|
LOR ;Length of Rehab in Days (Note: not needed for Outpt aggregate report)
|
|
I +SPNDCS D STATS I +LORRN S SPNLORS=SPNLORS+$$GET1^DIQ(154.1,LORRN,999.08),LORSC=LORSC+1 S:LORSC=1 BMLS=$$GET1^DIQ(154.1,LORRN,999.08) S MINLORS=$S($$GET1^DIQ(154.1,LORRN,999.08)<BMLS:$$GET1^DIQ(154.1,LORRN,999.08),1:BMLS)
|
|
I +SPNDCS S:LORSC=1 BHLS=$$GET1^DIQ(154.1,LORRN,999.08) S MAXLORS=$S($$GET1^DIQ(154.1,SPNPD1,999.08)>BHLS:$$GET1^DIQ(154.1,LORRN,999.08),1:BHLS)
|
|
I +SPNDCS&(+LORRN)&(+TFSRN) S TFS=$$GET1^DIQ(154.1,TFSRN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFCUMS=TFCUMS+(TFF-TFS),TFCS=TFCS+1
|
|
I +SPNDCS&(+LORRN)&(+TFGRN) S TFG=$$GET1^DIQ(154.1,TFGRN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFGCUMS=TFGCUMS+(TFF-TFG),TFGCS=TFGCS+1
|
|
CDSEV I +SPNDCS&(+LORRN)&($P($G(^SPNL(154.1,LORRN,0)),U,24)<5) S COMDISS=COMDISS+1
|
|
FRETSEV I +SPNDCS&(+LORRN)&(+TFURN) S TFU=$$GET1^DIQ(154.1,TFURN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFUCUMS=TFUCUMS+(TFU-TFF),TFUCS=TFUCS+1
|
|
SLSEV I +SPNDCS&(+SLSRN)&(+SLFRN) S SLS=$P($G(^SPNL(154.1,SLSRN,"SCORE")),U,1),SLF=$P($G(^SPNL(154.1,SLFRN,"SCORE")),U,1),SLCUMS=SLCUMS+(SLF-SLS),SLCS=SLCS+1
|
|
SLUSEV I +SPNDCS&(+SLFRN)&(+SLURN) S SLU=$P($G(^SPNL(154.1,SLURN,"SCORE")),U,1),SLF=$P($G(^SPNL(154.1,SLFRN,"SCORE")),U,1),SLUCUMS=SLUCUMS+(SLU-SLF),SLUCS=SLUCS+1
|
|
I +SPNDCM D STATS I +LORRN S SPNLORM=SPNLORM+$$GET1^DIQ(154.1,LORRN,999.08),LORMC=LORMC+1 S:LORMC=1 BMLM=$$GET1^DIQ(154.1,LORRN,999.08) S MINLORM=$S($$GET1^DIQ(154.1,LORRN,999.08)<BMLM:$$GET1^DIQ(154.1,LORRN,999.08),1:BMLM)
|
|
I +SPNDCM S:LORMC=1 BHLM=$$GET1^DIQ(154.1,LORRN,999.08) S MAXLORM=$S($$GET1^DIQ(154.1,LORRN,999.08)>BHLM:$$GET1^DIQ(154.1,LORRN,999.08),1:BHLM)
|
|
I +SPNDCM&(+LORRN)&(+TFSRN) S TFS=$$GET1^DIQ(154.1,TFSRN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFCUMM=TFCUMM+(TFF-TFS),TFCM=TFCM+1
|
|
I +SPNDCM&(+LORRN)&(+TFGRN) S TFG=$$GET1^DIQ(154.1,TFGRN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFGCUMM=TFGCUMM+(TFF-TFG),TFGCM=TFGCM+1
|
|
CDMOD I +SPNDCM&(+LORRN)&($P($G(^SPNL(154.1,LORRN,0)),U,24)<5) S COMDISM=COMDISM+1
|
|
FRETMOD I +SPNDCM&(+LORRN)&(+TFURN) S TFU=$$GET1^DIQ(154.1,TFURN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFUCUMM=TFUCUMM+(TFU-TFF),TFUCM=TFUCM+1
|
|
SLMOD I +SPNDCM&(+SLSRN)&(+SLFRN) S SLS=$P($G(^SPNL(154.1,SLSRN,"SCORE")),U,1),SLF=$P($G(^SPNL(154.1,SLFRN,"SCORE")),U,1),SLCUMM=SLCUMM+(SLF-SLS),SLCM=SLCM+1
|
|
SLUMOD I +SPNDCM&(+SLFRN)&(+SLURN) S SLU=$P($G(^SPNL(154.1,SLURN,"SCORE")),U,1),SLF=$P($G(^SPNL(154.1,SLFRN,"SCORE")),U,1),SLUCUMM=SLUCUMM+(SLU-SLF),SLUCM=SLUCM+1
|
|
I +SPNDCP D STATS I +LORRN S SPNLORP=SPNLORP+$$GET1^DIQ(154.1,LORRN,999.08),LORPC=LORPC+1 S:LORPC=1 BMLP=$$GET1^DIQ(154.1,LORRN,999.08) S MINLORP=$S($$GET1^DIQ(154.1,LORRN,999.08)<BMLP:$$GET1^DIQ(154.1,LORRN,999.08),1:BMLP)
|
|
I +SPNDCP S:LORPC=1 BHLP=$$GET1^DIQ(154.1,LORRN,999.08) S MAXLORP=$S($$GET1^DIQ(154.1,LORRN,999.08)>BHLP:$$GET1^DIQ(154.1,LORRN,999.08),1:BHLP)
|
|
I +SPNDCP&(+LORRN)&(+TFSRN) S TFS=$$GET1^DIQ(154.1,TFSRN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFCUMP=TFCUMP+(TFF-TFS),TFCP=TFCP+1
|
|
I +SPNDCP&(+LORRN)&(+TFGRN) S TFG=$$GET1^DIQ(154.1,TFGRN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFGCUMP=TFGCUMP+(TFF-TFG),TFGCP=TFGCP+1
|
|
CDPARA I +SPNDCP&(+LORRN)&($P($G(^SPNL(154.1,LORRN,0)),U,24)<5) S COMDISP=COMDISP+1
|
|
FRETPAR I +SPNDCP&(+LORRN)&(+TFURN) S TFU=$$GET1^DIQ(154.1,TFURN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFUCUMP=TFUCUMP+(TFU-TFF),TFUCP=TFUCP+1
|
|
SLPAR I +SPNDCP&(+SLSRN)&(+SLFRN) S SLS=$P($G(^SPNL(154.1,SLSRN,"SCORE")),U,1),SLF=$P($G(^SPNL(154.1,SLFRN,"SCORE")),U,1),SLCUMP=SLCUMP+(SLF-SLS),SLCP=SLCP+1
|
|
SLUPAR I +SPNDCP&(+SLFRN)&(+SLURN) S SLU=$P($G(^SPNL(154.1,SLURN,"SCORE")),U,1),SLF=$P($G(^SPNL(154.1,SLFRN,"SCORE")),U,1),SLUCUMP=SLUCUMP+(SLU-SLF),SLUCP=SLUCP+1
|
|
I +SPNDCL D STATS I +LORRN S SPNLORL=SPNLORL+$$GET1^DIQ(154.1,LORRN,999.08),LORLC=LORLC+1 S:LORLC=1 BMLL=$$GET1^DIQ(154.1,LORRN,999.08) S MINLORL=$S($$GET1^DIQ(154.1,LORRN,999.08)<BMLL:$$GET1^DIQ(154.1,LORRN,999.08),1:BMLL)
|
|
I +SPNDCL S:LORLC=1 BHLL=$$GET1^DIQ(154.1,LORRN,999.08) S MAXLORL=$S($$GET1^DIQ(154.1,LORRN,999.08)>BHLL:$$GET1^DIQ(154.1,LORRN,999.08),1:BHLL)
|
|
I +SPNDCL&(+LORRN)&(+TFSRN) S TFS=$$GET1^DIQ(154.1,TFSRN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFCUML=TFCUML+(TFF-TFS),TFCL=TFCL+1
|
|
I +SPNDCL&(+LORRN)&(+TFGRN) S TFG=$$GET1^DIQ(154.1,TFGRN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFGCUML=TFGCUML+(TFF-TFG),TFGCL=TFGCL+1
|
|
CDLOW I +SPNDCL&(+LORRN)&($P($G(^SPNL(154.1,LORRN,0)),U,24)<5) S COMDISL=COMDISL+1
|
|
FRETLOW I +SPNDCL&(+LORRN)&(+TFURN) S TFU=$$GET1^DIQ(154.1,TFURN,999.05),TFF=$$GET1^DIQ(154.1,LORRN,999.05),TFUCUML=TFUCUML+(TFU-TFF),TFUCL=TFUCL+1
|
|
SLLOW I +SPNDCL&(+SLSRN)&(+SLFRN) S SLS=$P($G(^SPNL(154.1,SLSRN,"SCORE")),U,1),SLF=$P($G(^SPNL(154.1,SLFRN,"SCORE")),U,1),SLCUML=SLCUML+(SLF-SLS),SLCL=SLCL+1
|
|
SLULOW I +SPNDCL&(+SLFRN)&(+SLURN) S SLU=$P($G(^SPNL(154.1,SLURN,"SCORE")),U,1),SLF=$P($G(^SPNL(154.1,SLFRN,"SCORE")),U,1),SLUCUML=SLUCUML+(SLU-SLF),SLUCL=SLUCL+1
|
|
S LORL=$S((MINLORS<MINLORM)&(MINLORS<MINLORP)&(MINLORS<MINLORL):MINLORS,(MINLORM<MINLORP)&(MINLORM<MINLORL):MINLORM,MINLORP<MINLORL:MINLORP,1:MINLORL)
|
|
S LORH=$S((MAXLORS>MAXLORM)&(MAXLORS>MAXLORP)&(MAXLORS>MAXLORL):MAXLORS,(MAXLORM>MAXLORP)&(MAXLORM>MAXLORL):MAXLORM,MAXLORP>MAXLORL:MAXLORP,1:MAXLORL)
|
|
Q
|
|
;
|
|
STATS ;finds record with Rehab Finish
|
|
S LORRN=0,TFSRN=0,TFGRN=0,TFURN=0,SLSRN=0,SLFRN=0,SLURN=0
|
|
S V=SPNPD1 F S V=$O(^SPNL(154.1,"B",SPNPD0,V)) Q:'+V D GETLOR
|
|
Q
|
|
GETLOR ;get Rec No. for LOR,TFS (TFF is same RN as LOR),TFU,TFG,SLS,SLF,SLU
|
|
Q:'$D(^SPNL(154.1,V,0))
|
|
Q:'+$P($G(^SPNL(154.1,V,2)),U,17)
|
|
Q:$P($G(^SPNL(154.1,V,8)),U,3)'=CARETYP
|
|
Q:$P($G(^SPNL(154.1,V,8)),U,2)<BDATE!($P($G(^SPNL(154.1,V,8)),U,2)>EDATE)
|
|
I $P(^SPNL(154.1,V,2),U,17)=6,($P(^SPNL(154.1,V,0),U,2)=2) S TFSRN=V
|
|
I $P(^SPNL(154.1,V,2),U,17)=7,($P(^SPNL(154.1,V,0),U,2)=2) S TFGRN=V
|
|
I $P(^SPNL(154.1,V,2),U,17)=10,($P(^SPNL(154.1,V,0),U,2)=2) S TFURN=V
|
|
I $P(^SPNL(154.1,V,2),U,17)=6,($P(^SPNL(154.1,V,0),U,2)=6) S SLSRN=V
|
|
I $P(^SPNL(154.1,V,2),U,17)=9,($P(^SPNL(154.1,V,0),U,2)=6) S SLFRN=V
|
|
I $P(^SPNL(154.1,V,2),U,17)=10,($P(^SPNL(154.1,V,0),U,2)=6) S SLURN=V
|
|
I $P($G(^SPNL(154.1,V,8)),U,2)'="",($P(^SPNL(154.1,V,2),U,17)=9) S LORRN=V
|
|
Q
|
|
EXIT ;
|
|
D EXIT^SPNAGGU
|
|
Q
|