source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNMSR1.m@ 1093

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