source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNMISS.m@ 813

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1SPNMISS ;WDE/SAN-DIEGO;CLEANUP REPORT ON MISSING DATA ELEMENTS; 1-18-2005
2 ;;2.0;Spinal Cord Dysfunction;**24**;01/02/97
3 ;
4 ;
5EN ;
6 W !!,"This report provides a list of patients with missing data in the SCD Registry."
7 W !,"Data elements checked are: Registration Status, SCI Network, SSN, Integration"
8 W !,"Control Number, Registration Date, and Date of Last Review."
9 W !!,"After viewing or printing the report, simply edit the patient records,"
10 W !,"inserting information into fields identified as having missing data."
11 W !,"Cleaning up such records is important to future development of the Registry.",!!
12 K ^TMP($J)
13 S SPNLEXIT=""
14 S ZTSAVE(DUZ)=""
15 D DEVICE^SPNPRTMT("QUED^SPNMISS","SCD Missing Data Report",.ZTSAVE) Q:SPNLEXIT
16 Q:POP
17 I $G(SPNIO)["Q" Q
18QUED ;
19 S (SPNCNT)=0
20 S DFN=0 F S DFN=$O(^SPNL(154,DFN)) Q:(DFN=0)!('+DFN) D
21 .S SPNCNT=SPNCNT+1
22 .I $E(IOST,1)="C" I SPNCNT#10=0 W "."
23 .S PTNAM=$$GET1^DIQ(154,DFN_",",.01)
24 .Q:PTNAM="" ;2-9-05
25 .F FIELD=.03,1.1,.02,.05 D TEST
26 .F FIELD=991.01,.09 D TTWO ;check ssn and icn
27 .D DUPSSN
28 .Q
29 D ^SPNMISS2
30KILL ;
31 K ^TMP($J),DATA,PAGE,STATS,EQ,PTNAM,DFN,SPNCON,SPNDD,SPNSSN,FIELD,SUBCNT,SSN,SPNLEXIT
32 K SPNIO,SPNCNT,SS,DUPDFN
33 Q
34TEST S DATA="",DATA=$$GET1^DIQ(154,DFN_",",FIELD)
35 I DATA="" D
36 .S SPNDD=$G(^DD(154,FIELD,0)),SPNDD=$P(SPNDD,U,1)
37 .I $D(^TMP($J,PTNAM,DFN,0))=0 S ^TMP($J,PTNAM,DFN,0)=""
38 .S ^TMP($J,PTNAM,DFN,FIELD)=SPNDD
39 Q
40TTWO ;test on patient file fields
41 S DATA="",DATA=$$GET1^DIQ(2,DFN_",",FIELD)
42 I DATA="" D
43 .S SPNDD=$G(^DD(2,FIELD,0)),SPNDD=$P(SPNDD,U,1)
44 .I $D(^TMP($J,PTNAM,DFN,0))=0 S ^TMP($J,PTNAM,DFN,0)=""
45 .S ^TMP($J,PTNAM,DFN,FIELD)=SPNDD
46 Q
47DUPSSN ;
48 S SUBCNT=0 S SSN=$$GET1^DIQ(2,DFN_",",.09)
49 S DUPDFN=0 F S DUPDFN=$O(^DPT("SSN",SSN,DUPDFN)) Q:(DUPDFN=0)!('+DUPDFN) I DUPDFN'=DFN D
50 .S SUBCNT=SUBCNT+1
51 .I $D(^TMP($J,PTNAM,DFN,0))=0 S ^TMP($J,PTNAM,DFN,0)=""
52 .S ^TMP($J,PTNAM,DFN,"SSN",SUBCNT)=DUPDFN
53 .Q
54 Q
Note: See TracBrowser for help on using the repository browser.