source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNMSR1.m@ 839

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1SPNMSR1 ;SAN/WDE/MS Canned report/10-26-2001
2 ;;2.0;Spinal Cord Dysfunction;**12,14,16**;01/02/1997
3EN ;
4 ;ask if they want all patients or just one
5 S SPNTRUE=0
6 S DIR(0)="YAO" ; Answer yes or no
7 S DIR("A")="Would you like all patients: "
8 S DIR("B")="NO"
9 S DIR("?")="Enter yes for all patients or no for a single patient."
10 D ^DIR I $D(DIRUT) D EXIT Q
11 I Y'=1 D PTLK I SPNTRUE=1 I +SPNDFN G DEV Q D EXIT Q
12 I Y'=1 I SPNTRUE=0 D EXIT Q
13REG ;Ask if they want to sort on a particular REGISTRATION STATUS
14 S DIR(0)="SO^A:ALL;0:NOT SCD;1:SCD - CURRENTLY SERVED;2:SCD - NOT CURRENTLY SERVED;X:EXPIRED"
15 S DIR("B")="A",DIR("A")="Select a Registration Status"
16 D ^DIR
17 I (Y="")!(Y["^") G EXIT Q
18 S SPNRET=Y
19SCI ;Ask if they want to sort out any SCI NETWORK
20 S DIR(0)="SO^A:ALL;Y:SCI NETWORK YES;N:SCI NETWORK NO"
21 S DIR("A")="Select a SCI NETWORK",DIR("B")="A"
22 D ^DIR
23 I (Y="")!(Y["^") G EXIT Q
24 I Y="Y" S Y=1
25 I Y="N" S Y=0
26 S SPNNET=Y
27MSTYPE ;Ask if user want a particular MS Subtype value
28 S DIR(0)="SO^A:ALL;UN:UNKNOWN;RR:RELAPSING-REMITTING;PP:PRIMARY PROGRESSIVE;SP:SECONDARY PROGRESSIVE;PR:PROGRESSIVE RELAPSING"
29 S DIR("B")="A",DIR("A")="Select a MS Subtype value"
30 D ^DIR
31 I (Y="")!(Y["^") G EXIT Q
32 S SPNMSS=Y
33DEV ;put the device call in calls here
34 S ZTSAVE("SPN*")=""
35 S SPNLEXIT=""
36 D DEVICE^SPNPRTMT("EN2^SPNMSR1","Print MS patients",.ZTSAVE) Q:SPNLEXIT
37 I SPNIO="Q" D EXIT Q
38 I IO'="" D EN2 D EXIT Q
39EN2 ;Start the search
40 ;
41 K ^UTILITY($J)
42 I $D(SPNDFN) D EDSS D COLL D ^SPNMSR2 D EXIT Q
43 S SPNDFN=0 F S SPNDFN=$O(^SPNL(154,SPNDFN)) Q:(SPNDFN="")!('+SPNDFN) D
44 .Q:$P($G(^SPNL(154,SPNDFN,0)),U,1)="" ;patch 16
45 .D TESTMS Q:SPNTRUE=0
46 .I SPNTRUE=1 I SPNRET'="A" D TEST1 Q:SPNTRUE=0
47 .I SPNTRUE=1 I SPNNET'="A" D TEST2 Q:SPNTRUE=0
48 .I SPNTRUE=1 I SPNMSS'="A" D TEST3 Q:SPNTRUE=0
49 .I SPNTRUE=1 D EDSS D COLL
50 .Q
51 D ^SPNMSR2 ;print routine
52EXIT ;
53 K ^UTILITY($J)
54 K SPNTRUE,SPNTYP,SPNNU,SPNMSS,SPNDFN,Y,DIR,SPNRET,SPNNET,SPNMSS,ZTSAVE,SPNLEXIT,SPNIO,SPNDAT,SPNFDT2,SPNFD0,SPNEDS,SPNFDT,SPNEDSS
55 K SPNNAME,SPNSSN,SPNSUB,SPNPRO,SPNLAS,SPNNEX
56 Q
57TESTMS ;test patient for a etiology of MS
58 S SPNTRUE=0
59 S SPNTYP="",SPNNU=""
60 S SPNNU=0 F S SPNNU=$O(^SPNL(154,SPNDFN,"E",SPNNU)) Q:(SPNNU="")!('+SPNNU) D
61 .S SPNTYP=$P($G(^SPNL(154,SPNDFN,"E",SPNNU,0)),U,1)
62 .S SPNTYP=$G(^SPNL(154.03,SPNTYP,0))
63 .I SPNTYP["MULTIPLE SCLEROSIS" S SPNTRUE=1 S SPNONS=$P($G(^SPNL(154,SPNDFN,"E",SPNNU,0)),U,2) S SPNNU=99999
64 Q
65TEST1 ;
66 S SPNDAT=""
67 S SPNDAT=$G(^SPNL(154,SPNDFN,0)) I SPNDAT="" S SPNTRUE=0 Q
68 S SPNDAT=$P($G(SPNDAT),U,3) I SPNDAT="" S SPNTRUE=0 Q
69 S:SPNDAT'=SPNRET SPNTRUE=0 Q ;Failed
70 Q
71TEST2 ;test for SCI NETWORK
72 S SPNDAT=""
73 S SPNDAT=$G(^SPNL(154,SPNDFN,1)) I SPNDAT="" S SPNTRUE=0 Q
74 S SPNDAT=$P($G(SPNDAT),U,1) I SPNDAT="" S SPNTRUE=0 Q
75 I SPNDAT'=SPNNET S SPNTRUE=0 Q ;Failed
76 Q
77TEST3 ;test for MS SUBTYPE
78 S SPNDAT=""
79 S SPNDAT=$G(^SPNL(154,SPNDFN,2)) I SPNDAT="" S SPNTRUE=0 Q
80 S SPNDAT=$P($G(SPNDAT),U,2) I SPNDAT="" S SPNTRUE=0 Q
81 I SPNDAT'=SPNMSS S SPNTRUE=0 Q ;Failed
82 Q
83EDSS ;Get patients latest EDSS score from 154.1
84 S SPNFDT2="",SPNEDSS=""
85 S SPNFD0=0 F S SPNFD0=$O(^SPNL(154.1,"B",SPNDFN,SPNFD0)) Q:(SPNFD0="")!('+SPNFD0) D
86 .S SPNEDS=$G(^SPNL(154.1,SPNFD0,"MS"))
87 .S SPNEDS=$P($G(SPNEDS),U,9)
88 .Q:SPNEDS=""
89 .S SPNFDT=$G(^SPNL(154.1,SPNFD0,0)) Q:SPNFDT=""
90 .S SPNFDT=$P($G(SPNFDT),U,4) Q:SPNFDT=""
91 .I SPNFDT>SPNFDT2 S SPNFDT2=SPNFDT,SPNEDSS=$P($G(^SPNL(154.2,SPNEDS,0)),U,1)
92 .Q
93 I $G(SPNFDT2) S Y=SPNFDT2 X ^DD("DD") S SPNFDT2=Y K Y
94 Q
95COLL ;patient passed the test and we want them
96 S Y=SPNONS X ^DD("DD") S SPNONS=Y
97 S SPNAME=$$GET1^DIQ(154,SPNDFN_",",.01)
98 S SPNSSN=$$GET1^DIQ(2,SPNDFN_",",.09)
99 S SPNSUB=$$GET1^DIQ(154,SPNDFN_",",2.2)
100 S SPNPRO=$$GET1^DIQ(154,SPNDFN_",",8.1)
101 S SPNLAS=$$GET1^DIQ(154,SPNDFN_",",999.07)
102 S SPNNEX=$$GET1^DIQ(154,SPNDFN_",",999.08)
103 S ^UTILITY($J,SPNAME,SPNDFN)=SPNAME_"^"_SPNSSN_"^"_SPNSUB_"^"_SPNPRO_"^"_SPNLAS_"^"_SPNNEX_"^"_SPNONS_"^"_SPNFDT2_"^"_SPNEDSS
104 S (SPNAME,SPNSSN,SPNSUB,SPNPRO,SPNLAS,SPNNEX,SPNONS,SPNFDT2,SPNEDSS)=""
105 Q
106PTLK ;
107 S DIC="^SPNL(154,",DIC(0)="AEQMNZ",DIC("A")="Select Patient: "
108 D ^DIC
109 S SPNDFN=$P(Y,U,1)
110 I '+Y G EXIT Q
111 D TESTMS
112 I +SPNDFN I SPNTRUE=0 W !!,"Patient does not have an etiology of MS."
113 Q
Note: See TracBrowser for help on using the repository browser.