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