VistA-WorldVistAEHR/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNMSR1.m

114 lines
4.1 KiB
Mathematica

SPNMSR1 ;SAN/WDE/MS Canned report/10-26-2001
;;2.0;Spinal Cord Dysfunction;**12,14,16**;01/02/1997
EN ;
;ask if they want all patients or just one
S SPNTRUE=0
S DIR(0)="YAO" ; Answer yes or no
S DIR("A")="Would you like all patients: "
S DIR("B")="NO"
S DIR("?")="Enter yes for all patients or no for a single patient."
D ^DIR I $D(DIRUT) D EXIT Q
I Y'=1 D PTLK I SPNTRUE=1 I +SPNDFN G DEV Q D EXIT Q
I Y'=1 I SPNTRUE=0 D EXIT Q
REG ;Ask if they want to sort on a particular REGISTRATION STATUS
S DIR(0)="SO^A:ALL;0:NOT SCD;1:SCD - CURRENTLY SERVED;2:SCD - NOT CURRENTLY SERVED;X:EXPIRED"
S DIR("B")="A",DIR("A")="Select a Registration Status"
D ^DIR
I (Y="")!(Y["^") G EXIT Q
S SPNRET=Y
SCI ;Ask if they want to sort out any SCI NETWORK
S DIR(0)="SO^A:ALL;Y:SCI NETWORK YES;N:SCI NETWORK NO"
S DIR("A")="Select a SCI NETWORK",DIR("B")="A"
D ^DIR
I (Y="")!(Y["^") G EXIT Q
I Y="Y" S Y=1
I Y="N" S Y=0
S SPNNET=Y
MSTYPE ;Ask if user want a particular MS Subtype value
S DIR(0)="SO^A:ALL;UN:UNKNOWN;RR:RELAPSING-REMITTING;PP:PRIMARY PROGRESSIVE;SP:SECONDARY PROGRESSIVE;PR:PROGRESSIVE RELAPSING"
S DIR("B")="A",DIR("A")="Select a MS Subtype value"
D ^DIR
I (Y="")!(Y["^") G EXIT Q
S SPNMSS=Y
DEV ;put the device call in calls here
S ZTSAVE("SPN*")=""
S SPNLEXIT=""
D DEVICE^SPNPRTMT("EN2^SPNMSR1","Print MS patients",.ZTSAVE) Q:SPNLEXIT
I SPNIO="Q" D EXIT Q
I IO'="" D EN2 D EXIT Q
EN2 ;Start the search
;
K ^UTILITY($J)
I $D(SPNDFN) D EDSS D COLL D ^SPNMSR2 D EXIT Q
S SPNDFN=0 F S SPNDFN=$O(^SPNL(154,SPNDFN)) Q:(SPNDFN="")!('+SPNDFN) D
.Q:$P($G(^SPNL(154,SPNDFN,0)),U,1)="" ;patch 16
.D TESTMS Q:SPNTRUE=0
.I SPNTRUE=1 I SPNRET'="A" D TEST1 Q:SPNTRUE=0
.I SPNTRUE=1 I SPNNET'="A" D TEST2 Q:SPNTRUE=0
.I SPNTRUE=1 I SPNMSS'="A" D TEST3 Q:SPNTRUE=0
.I SPNTRUE=1 D EDSS D COLL
.Q
D ^SPNMSR2 ;print routine
EXIT ;
K ^UTILITY($J)
K SPNTRUE,SPNTYP,SPNNU,SPNMSS,SPNDFN,Y,DIR,SPNRET,SPNNET,SPNMSS,ZTSAVE,SPNLEXIT,SPNIO,SPNDAT,SPNFDT2,SPNFD0,SPNEDS,SPNFDT,SPNEDSS
K SPNNAME,SPNSSN,SPNSUB,SPNPRO,SPNLAS,SPNNEX
Q
TESTMS ;test patient for a etiology of MS
S SPNTRUE=0
S SPNTYP="",SPNNU=""
S SPNNU=0 F S SPNNU=$O(^SPNL(154,SPNDFN,"E",SPNNU)) Q:(SPNNU="")!('+SPNNU) D
.S SPNTYP=$P($G(^SPNL(154,SPNDFN,"E",SPNNU,0)),U,1)
.S SPNTYP=$G(^SPNL(154.03,SPNTYP,0))
.I SPNTYP["MULTIPLE SCLEROSIS" S SPNTRUE=1 S SPNONS=$P($G(^SPNL(154,SPNDFN,"E",SPNNU,0)),U,2) S SPNNU=99999
Q
TEST1 ;
S SPNDAT=""
S SPNDAT=$G(^SPNL(154,SPNDFN,0)) I SPNDAT="" S SPNTRUE=0 Q
S SPNDAT=$P($G(SPNDAT),U,3) I SPNDAT="" S SPNTRUE=0 Q
S:SPNDAT'=SPNRET SPNTRUE=0 Q ;Failed
Q
TEST2 ;test for SCI NETWORK
S SPNDAT=""
S SPNDAT=$G(^SPNL(154,SPNDFN,1)) I SPNDAT="" S SPNTRUE=0 Q
S SPNDAT=$P($G(SPNDAT),U,1) I SPNDAT="" S SPNTRUE=0 Q
I SPNDAT'=SPNNET S SPNTRUE=0 Q ;Failed
Q
TEST3 ;test for MS SUBTYPE
S SPNDAT=""
S SPNDAT=$G(^SPNL(154,SPNDFN,2)) I SPNDAT="" S SPNTRUE=0 Q
S SPNDAT=$P($G(SPNDAT),U,2) I SPNDAT="" S SPNTRUE=0 Q
I SPNDAT'=SPNMSS S SPNTRUE=0 Q ;Failed
Q
EDSS ;Get patients latest EDSS score from 154.1
S SPNFDT2="",SPNEDSS=""
S SPNFD0=0 F S SPNFD0=$O(^SPNL(154.1,"B",SPNDFN,SPNFD0)) Q:(SPNFD0="")!('+SPNFD0) D
.S SPNEDS=$G(^SPNL(154.1,SPNFD0,"MS"))
.S SPNEDS=$P($G(SPNEDS),U,9)
.Q:SPNEDS=""
.S SPNFDT=$G(^SPNL(154.1,SPNFD0,0)) Q:SPNFDT=""
.S SPNFDT=$P($G(SPNFDT),U,4) Q:SPNFDT=""
.I SPNFDT>SPNFDT2 S SPNFDT2=SPNFDT,SPNEDSS=$P($G(^SPNL(154.2,SPNEDS,0)),U,1)
.Q
I $G(SPNFDT2) S Y=SPNFDT2 X ^DD("DD") S SPNFDT2=Y K Y
Q
COLL ;patient passed the test and we want them
S Y=SPNONS X ^DD("DD") S SPNONS=Y
S SPNAME=$$GET1^DIQ(154,SPNDFN_",",.01)
S SPNSSN=$$GET1^DIQ(2,SPNDFN_",",.09)
S SPNSUB=$$GET1^DIQ(154,SPNDFN_",",2.2)
S SPNPRO=$$GET1^DIQ(154,SPNDFN_",",8.1)
S SPNLAS=$$GET1^DIQ(154,SPNDFN_",",999.07)
S SPNNEX=$$GET1^DIQ(154,SPNDFN_",",999.08)
S ^UTILITY($J,SPNAME,SPNDFN)=SPNAME_"^"_SPNSSN_"^"_SPNSUB_"^"_SPNPRO_"^"_SPNLAS_"^"_SPNNEX_"^"_SPNONS_"^"_SPNFDT2_"^"_SPNEDSS
S (SPNAME,SPNSSN,SPNSUB,SPNPRO,SPNLAS,SPNNEX,SPNONS,SPNFDT2,SPNEDSS)=""
Q
PTLK ;
S DIC="^SPNL(154,",DIC(0)="AEQMNZ",DIC("A")="Select Patient: "
D ^DIC
S SPNDFN=$P(Y,U,1)
I '+Y G EXIT Q
D TESTMS
I +SPNDFN I SPNTRUE=0 W !!,"Patient does not have an etiology of MS."
Q