source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNAGGE.m@ 1261

Last change on this file since 1261 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.3 KB
Line 
1SPNAGGE ;SD/CM- AGGREGATE ANUAL EVAL OUTCOMES REPORT; 2-21-2003
2 ;;2.0;Spinal Cord Dysfunction;**20,21**;01/02/97
3 ;
4EN ;
5 S U="^"
6 D SET^SPNAGGEU
7PARAMS ;
8 D CED
9 G:SPNLEXIT=1 EXIT
10DEVICE ;
11 S ZTSAVE("SPN*")="",ZTSAVE("B*")="",ZTSAVE("AGE*")="",ZTSAVE("MIN*")=""
12 S ZTSAVE("MAX*")="",ZTSAVE("LOR*")="",ZTSAVE("TF*")="",ZTSAVE("SEX*")=""
13 S ZTSAVE("SL*")="",ZTSAVE("CARETYP")="",ZTSAVE("MF*")=""
14 S ZTSAVE("EDATE")="",ZTSAVE("BDATE")="",ZTSAVE("LINE")="",ZTSAVE("I")=""
15 S ZTSAVE("ASIA*")="",ZTSAVE("C*")=""
16 W !
17 D DEVICE^SPNPRTMT("PRINT^SPNAGGPE","Annual Eval Outcomes",.ZTSAVE) Q:SPNLEXIT
18 I SPNIO="Q" D EXIT Q ; Print was queued
19 I IO'="" D PRINT^SPNAGGPE D EXIT Q ; Print was not queued
20 D EXIT
21 Q
22CED ;date range for Record Date
23 D DATE^SPNAGGA
24 Q
25OIEN ;
26 S SPNPD1=0 F S SPNPD1=$O(^SPNL(154.1,"B",SPNPD0,SPNPD1)) Q:'+SPNPD1 D DIAGCAT
27 Q
28DIAGCAT ;get ASIA Highest Neuro Level and ASIA Imp Scale
29 S SPNDCS=0,SPNDCM=0,SPNDCP=0,SPNDCL=0
30 Q:'$D(^SPNL(154.1,SPNPD1,0))
31 Q:'$D(^SPNL(154.1,SPNPD1,"ASIA"))
32 Q:'$D(^SPNL(154.1,SPNPD1,8))
33 Q:$P(^SPNL(154.1,SPNPD1,0),U,2)'=3
34 Q:$P(^SPNL(154.1,SPNPD1,8),U,3)'=CARETYP
35 Q:$P($G(^SPNL(154.1,SPNPD1,0)),U,4)<BDATE!($P($G(^SPNL(154.1,SPNPD1,0)),U,4)>EDATE)
36 Q:$P($G(^SPNL(154.1,SPNPD1,0)),U,1)=SPNNODUP
37 S SPNNODUP=$P($G(^SPNL(154.1,SPNPD1,0)),U,1)
38 S ASIAONE=$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,1),ASIAFRTN=$P($G(^SPNL(154.1,SPNPD1,"ASIA")),U,14)
39 I "ABC"[ASIAONE,ASIAFRTN<5 S SPNDCS=1
40 I "ABC"[ASIAONE,ASIAFRTN<5 S SPNLSTDT="S"
41 I "ABC"[ASIAONE&(ASIAFRTN>4)&(ASIAFRTN<9) S SPNDCM=1
42 I "ABC"[ASIAONE&(ASIAFRTN>4)&(ASIAFRTN<9) S SPNLSTDT="M"
43 I "ABC"[ASIAONE,ASIAFRTN>8 S SPNDCP=1
44 I "ABC"[ASIAONE,ASIAFRTN>8 S SPNLSTDT="P"
45 I ASIAONE="D",ASIAFRTN<31 S SPNDCL=1
46 I ASIAONE="D",ASIAFRTN<31 S SPNLSTDT="L"
47 I SPNLSTDT="S" S SPNSEVC=SPNSEVC+1
48 I SPNLSTDT="M" S SPNMODC=SPNMODC+1
49 I SPNLSTDT="P" S SPNPARC=SPNPARC+1
50 I SPNLSTDT="L" S SPNLOWC=SPNLOWC+1
51 S SPNDIAGC=SPNDIAGC+1
52 ;
53AGE ;
54 S AGECALL=$$GET1^DIQ(154.1,SPNPD1,999.025)
55 I +SPNDCS S SPNAGES=SPNAGES+AGECALL,AGESC=AGESC+1 S:AGESC=1 BMAS=AGECALL S MINAGES=$S(AGECALL<BMAS:AGECALL,1:BMAS)
56 I +SPNDCS S:AGESC=1 BHAS=AGECALL S MAXAGES=$S(AGECALL>BHAS:AGECALL,1:BHAS)
57 I +SPNDCM S SPNAGEM=SPNAGEM+AGECALL,AGEMC=AGEMC+1 S:AGEMC=1 BMAM=AGECALL S MINAGEM=$S(AGECALL<BMAM:AGECALL,1:BMAM)
58 I +SPNDCM S:AGEMC=1 BHAM=AGECALL S MAXAGEM=$S(AGECALL>BHAM:AGECALL,1:BHAM)
59 I +SPNDCP S SPNAGEP=SPNAGEP+AGECALL,AGEPC=AGEPC+1 S:AGEPC=1 BMAP=AGECALL S MINAGEP=$S(AGECALL<BMAP:AGECALL,1:BMAP)
60 I +SPNDCP S:AGEPC=1 BHAP=AGECALL S MAXAGEP=$S(AGECALL>BHAP:AGECALL,1:BHAP)
61 I +SPNDCL S SPNAGEL=SPNAGEL+AGECALL,AGELC=AGELC+1 S:AGELC=1 BMAL=AGECALL S MINAGEL=$S(AGECALL<BMAL:AGECALL,1:BMAL)
62 I +SPNDCL S:AGELC=1 BHAL=AGECALL S MAXAGEL=$S(AGECALL>BHAL:AGECALL,1:BHAL)
63 S AGEL=$S((MINAGES<MINAGEM)&(MINAGES<MINAGEP)&(MINAGES<MINAGEL):MINAGES,(MINAGEM<MINAGEP)&(MINAGEM<MINAGEL):MINAGEM,MINAGEP<MINAGEL:MINAGEP,1:MINAGEL)
64 S AGEH=$S((MAXAGES>MAXAGEM)&(MAXAGES>MAXAGEP)&(MAXAGES>MAXAGEL):MAXAGES,(MAXAGEM>MAXAGEP)&(MAXAGEM>MAXAGEL):MAXAGEM,MAXAGEP>MAXAGEL:MAXAGEP,1:MAXAGEL)
65 ;
66SEX ;
67 S SEXCALL=$P(^DPT($P(^SPNL(154.1,SPNPD1,0),U,1),0),U,2)
68 I +SPNDCS,SEXCALL="M" S SPNSEXS=SPNSEXS+1
69 I +SPNDCM,SEXCALL="M" S SPNSEXM=SPNSEXM+1
70 I +SPNDCP,SEXCALL="M" S SPNSEXP=SPNSEXP+1
71 I +SPNDCL,SEXCALL="M" S SPNSEXL=SPNSEXL+1
72LOR ;Let's obtain record
73 I +SPNDCS D STATS I +TFSRN S TFS=TFS+TFSCALL,TFCS=TFCS+1
74 I +SPNDCS&(+MFSRN) S MFS=MFS+MFSCALL,MFCS=MFCS+1
75 I +SPNDCS&(+CFSRN) S CFS=CFS+CFSCALL,CFCS=CFCS+1
76 I +SPNDCS&(+CPIRN) S CPIS=CPIS+CPICALL,CPICS=CPICS+1
77 I +SPNDCS&(+CCIRN) S CCIS=CCIS+CCICALL,CCICS=CCICS+1
78 I +SPNDCS&(+CMRN) S CMS=CMS+CMCALL,CMCS=CMCS+1
79 I +SPNDCS&(+CORN) S COS=COS+COCALL,COCS=COCS+1
80 I +SPNDCS&(+CSIRN) S CSIS=CSIS+CSICALL,CSICS=CSICS+1
81 I +SPNDCS&(+CERN) S CES=CES+CECALL,CECS=CECS+1
82 I +SPNDCS&(+SLSRN) S SLSS=SLSS+SLSCALL,SLCS=SLCS+1
83 ;
84 I +SPNDCM D STATS I +TFSRN S TFM=TFM+TFSCALL,TFCM=TFCM+1
85 I +SPNDCM&(+MFSRN) S MFM=MFM+MFSCALL,MFCM=MFCM+1
86 I +SPNDCM&(+CFSRN) S CFM=CFM+CFSCALL,CFCM=CFCM+1
87 I +SPNDCM&(+CPIRN) S CPIM=CPIM+CPICALL,CPICM=CPICM+1
88 I +SPNDCM&(+CCIRN) S CCIM=CCIM+CCICALL,CCICM=CCICM+1
89 I +SPNDCM&(+CMRN) S CMM=CMM+CMCALL,CMCM=CMCM+1
90 I +SPNDCM&(+CORN) S COM=COM+COCALL,COCM=COCM+1
91 I +SPNDCM&(+CSIRN) S CSIM=CSIM+CSICALL,CSICM=CSICM+1
92 I +SPNDCM&(+CERN) S CEM=CEM+CECALL,CECM=CECM+1
93 I +SPNDCM&(+SLSRN) S SLSM=SLSM+SLSCALL,SLCM=SLCM+1
94 ;
95 I +SPNDCP D STATS I +TFSRN S TFP=TFP+TFSCALL,TFCP=TFCP+1
96 I +SPNDCP&(+MFSRN) S MFP=MFP+MFSCALL,MFCP=MFCP+1
97 I +SPNDCP&(+CFSRN) S CFP=CFP+CFSCALL,CFCP=CFCP+1
98 I +SPNDCP&(+CPIRN) S CPIP=CPIP+CPICALL,CPICP=CPICP+1
99 I +SPNDCP&(+CCIRN) S CCIP=CCIP+CCICALL,CCICP=CCICP+1
100 I +SPNDCP&(+CMRN) S CMP=CMP+CMCALL,CMCP=CMCP+1
101 I +SPNDCP&(+CORN) S COP=COP+COCALL,COCP=COCP+1
102 I +SPNDCP&(+CSIRN) S CSIP=CSIP+CSICALL,CSICP=CSICP+1
103 I +SPNDCP&(+CERN) S CEP=CEP+CECALL,CECP=CECP+1
104 I +SPNDCP&(+SLSRN) S SLSP=SLSP+SLSCALL,SLCP=SLCP+1
105 ;
106 I +SPNDCL D STATS I +TFSRN S TFL=TFL+TFSCALL,TFCL=TFCL+1
107 I +SPNDCL&(+MFSRN) S MFL=MFL+MFSCALL,MFCL=MFCL+1
108 I +SPNDCL&(+CFSRN) S CFL=CFL+CFSCALL,CFCL=CFCL+1
109 I +SPNDCL&(+CPIRN) S CPIL=CPIL+CPICALL,CPICL=CPICL+1
110 I +SPNDCL&(+CCIRN) S CCIL=CCIL+CCICALL,CCICL=CCICL+1
111 I +SPNDCL&(+CMRN) S CML=CML+CMCALL,CMCL=CMCL+1
112 I +SPNDCL&(+CORN) S COL=COL+COCALL,COCL=COCL+1
113 I +SPNDCL&(+CSIRN) S CSIL=CSIL+CSICALL,CSICL=CSICL+1
114 I +SPNDCL&(+CERN) S CEL=CEL+CECALL,CECL=CECL+1
115 I +SPNDCL&(+SLSRN) S SLSL=SLSL+SLSCALL,SLCL=SLCL+1
116 Q
117 ;
118STATS ;finds record
119 S TFSRN=0,MFSRN=0,CFSRN=0,CPIRN=0,CCIRN=0,CMRN=0,CORN=0,CSIRN=0,CERN=0,SLSRN=0
120 S V=SPNPD1 F S V=$O(^SPNL(154.1,"B",SPNPD0,V)) Q:'+V D GETLOR
121 S TFSCALL=$$GET1^DIQ(154.1,TFSRN,999.05)
122 S MFSCALL=$$GET1^DIQ(154.1,MFSRN,999.03)
123 S CFSCALL=$$GET1^DIQ(154.1,CFSRN,999.04)
124 S CPICALL=$P($G(^SPNL(154.1,CPIRN,"CHART")),U,1)
125 S CCICALL=$P($G(^SPNL(154.1,CCIRN,"CHART")),U,6)
126 S CMCALL=$P($G(^SPNL(154.1,CMRN,"CHART")),U,2)
127 S COCALL=$P($G(^SPNL(154.1,CORN,"CHART")),U,3)
128 S CSICALL=$P($G(^SPNL(154.1,CSIRN,"CHART")),U,4)
129 S CECALL=$P($G(^SPNL(154.1,CERN,"CHART")),U,5)
130 S SLSCALL=$P($G(^SPNL(154.1,SLSRN,"SCORE")),U,1)
131 Q
132GETLOR ;get Rec No. for TFS,MFS,CFS,CPI,SLS, etc
133 Q:'$D(^SPNL(154.1,V,0))
134 Q:$P($G(^SPNL(154.1,V,8)),U,3)'=CARETYP
135 Q:$P($G(^SPNL(154.1,V,0)),U,4)<BDATE!($P($G(^SPNL(154.1,V,0)),U,4)>EDATE)
136 I $P(^SPNL(154.1,V,0),U,2)=2 S (TFSRN,MFSRN,CFSRN)=V
137 I $P(^SPNL(154.1,V,0),U,2)=4 S (CPIRN,CCIRN,CMRN,CORN,CSIRN,CERN)=V
138 I $P(^SPNL(154.1,V,0),U,2)=6 S SLSRN=V
139 Q
140EXIT ;
141 D EXIT^SPNAGGEU
142 Q
Note: See TracBrowser for help on using the repository browser.