source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNICD2.m@ 1733

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1SPNICD2 ;SAN/WDE/Report of PT's with particular ICD9's
2 ;;2.0;Spinal Cord Dysfunction;**14,15**;01/02/1997
3EN ;
4 S Y=SPNSTRT X ^DD("DD") S SPNSTRT=Y,Y=SPNEND X ^DD("DD") S SPNEND=Y K Y
5 S (SPNPA,SPNEXIT)=0 I $D(^UTILITY($J))=0 S SPNPA=1 D HDR W !,"No data to report",!!! I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR I 'Y S SPNEXIT=1 D CLOSE^SPNPRTMT Q
6 S SPNDFN=0 F S SPNDFN=$O(^UTILITY($J,SPNDFN)) Q:(SPNDFN=0)!('+SPNDFN) D EN2
7 D ZAP^SPNICD1
8 D CLOSE^SPNPRTMT
9 Q
10 ;-----------------------------------------------------------------
11EN2 S SPNPTF=0 F S SPNPTF=$O(^UTILITY($J,SPNDFN,SPNPTF)) Q:(SPNPTF=0)!('+SPNPTF) D EN3
12 Q
13 ;----------------------------------------------------------------
14EN3 I SPNPA=0 S SPNPA=1 D HDR
15 S SPNDATA=$G(^UTILITY($J,SPNDFN,SPNPTF)) Q:SPNDATA=""
16 S SPNREG=$$GET1^DIQ(154,SPNDFN_",",.03)
17 I SPNREG="" S SPNREG="**NOT IN REGISTRY**"
18 S SPNAM=$P(^DPT(SPNDFN,0),U,1),SPNSSN=$P(^DPT(SPNDFN,0),U,9)
19 S SPNLVL=$$GET1^DIQ(154,SPNDFN_",",2.1)
20 W !,$E(SPNAM,1,28),?30,SPNSSN,?40,SPNREG,?67,SPNLVL
21 W !,"Admission: ",$$GET1^DIQ(45,SPNPTF_",",2)
22 W !,"DXLS: ",$$GET1^DIQ(45,SPNPTF_",",79)
23 W ?14,"ICD2: ",$$GET1^DIQ(45,SPNPTF_",",79.16)
24 W ?28,"ICD3: ",$$GET1^DIQ(45,SPNPTF_",",79.17)
25 W ?42,"ICD4: ",$$GET1^DIQ(45,SPNPTF_",",79.18)
26 W ?56,"ICD5: ",$$GET1^DIQ(45,SPNPTF_",",79.19)
27 W !,"ICD6: ",$$GET1^DIQ(45,SPNPTF_",",79.201)
28 W ?14,"ICD7: ",$$GET1^DIQ(45,SPNPTF_",",79.21)
29 W ?28,"ICD8: ",$$GET1^DIQ(45,SPNPTF_",",79.22)
30 W ?42,"ICD9: ",$$GET1^DIQ(45,SPNPTF_",",79.23)
31 W ?56,"ICD10: ",$$GET1^DIQ(45,SPNPTF_",",79.24)
32 W !,"----------------------------------------------------------------------------"
33 I $Y>(IOSL-5) D HDR I SPNEXIT=1 K ^UTILITY($J) Q
34 Q
35 ;---------------------------------------------------------------
36HDR ;
37 I $E(IOST,1)="P" I SPNPA'=1 W #
38 I $E(IOST,1)="C" D Q:SPNEXIT
39 .I SPNPA=1 W @IOF Q
40 .I SPNPA'=1 D Q:SPNEXIT
41 ..N DIR S DIR(0)="E" D ^DIR I 'Y S SPNEXIT=1
42 ..K Y
43 ..W @IOF
44 ..Q
45 .Q
46 Q:SPNEXIT
47 S SPNTAB=$S(SPNANS=1:18,SPNANS=2:23,1:2)
48 W !?SPNTAB,$S(SPNIN="JUST":"Patients in the Registry only",1:"Combined report -- Pts in Registry AND all others")
49 W !?29,"ICD9 Code Search",?72,"Page: ",SPNPA
50 W !?10,"Ran on admissions from ",SPNSTRT," to ",SPNEND
51 W !!!,"Patient",?30,"SSN",?40,"Registration Status",?65,"SCI Level"
52 W !,"Admission Date"
53 W !,"-----------------------------------------------------------------------------"
54 S SPNPA=SPNPA+1
Note: See TracBrowser for help on using the repository browser.