source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPM2B.m@ 1470

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1SPNPM2B ;SD/AB-PROGRAM MEASURE #2 (CONTINUATION) ;4/9/98
2 ;;2.0;Spinal Cord Dysfunction;**6**;01/02/1997
3MAIN ;-- Called by MAIN^SPNPM2
4 D ^SPNPMDX ;-- Collect SCI ICD-9 codes
5 D GETPTF
6 D GETICD
7EXIT ;
8 Q
9GETPTF ;-- Get all Pts in ^TMP($J,"SPNPM2","TOT_ONSET",DFN) who have a PTF Admission Date on or after Date of Onset but before END_DT (End Date of FY)
10 Q:'$D(^TMP($J,"SPNPM2","TOT_ONSET"))
11 S SPN("DFN")=0
12 F S SPN("DFN")=$O(^TMP($J,"SPNPM2","TOT_ONSET",SPN("DFN"))) Q:'+SPN("DFN") D
13 .S SPN("ONS_DT")=^TMP($J,"SPNPM2","TOT_ONSET",SPN("DFN"))
14 .Q:'$D(^DGPT("B",SPN("DFN")))
15 .S (SPN("PTF_IEN"),SPN("PTF_FLG"))=0
16 .F S SPN("PTF_IEN")=$O(^DGPT("B",SPN("DFN"),SPN("PTF_IEN"))) Q:'+SPN("PTF_IEN")!(+SPN("PTF_FLG")) D
17 ..;-- Set PTF Admission Date (PTF_ADMDT) and Discharge Date (PTF_DCDT)
18 ..S SPN("PTF_ADMDT")=$P($G(^DGPT(SPN("PTF_IEN"),0)),U,2),SPN("PTF_DCDT")=$P($G(^DGPT(SPN("PTF_IEN"),70)),U)
19 ..Q:'+SPN("PTF_ADMDT")
20 ..;-- check to see if PTF Admission Date is on or after Date of Onset and before SPN("END_DT")
21 ..I SPN("PTF_ADMDT")'<SPN("ONS_DT")&(SPN("PTF_ADMDT")'>SPN("END_DT")) D
22 ...;-- Okay, now check to make sure PTF record indicates a SCI/D Dx. quit otherwise
23 ...S SPN("ICD_FLG")=0 D CHKICD I +SPN("ICD_FLG") D
24 ....;-- Now make sure PTF Record has been Transmitted and Type=PTF, quit otherwise
25 ....I $P($G(^DGPT(SPN("PTF_IEN"),0)),U,6)'=3&($P($G(^(0)),U,11)'=1) Q
26 ....;-- Okay, then set into ^TMP($J,"SPNPM2","TOT_PTF",DFN)
27 ....S ^TMP($J,"SPNPM2","TOT_PTF",SPN("DFN"))=SPN("PTF_ADMDT")_"^"_SPN("PTF_DCDT")_"^"_SPN("ONS_DT")_"^"_SPN("PTF_IEN") S SPN("PTF_FLG")=1 ;W "P"
28 ....Q
29 ...Q
30 ..Q
31 .Q
32 Q
33GETICD ;-- Get all SCD pts who have any ICD-9 codes in any PTF record
34 ;-- Store into ^TMP($J,"SPNPM2","TOT_ICD",DFN) global
35 ;-- Quit if '$D(^TMP($J,"SPNPM2","ALL_SCD"))
36 Q:'$D(^TMP($J,"SPNPM2","ALL_SCD"))
37 ;-- Inititalze SPN("DFN")
38 S SPN("DFN")=0
39 F S SPN("DFN")=$O(^TMP($J,"SPNPM2","ALL_SCD",SPN("DFN"))) Q:'+SPN("DFN") D
40 .;-- Quit if no PTF record found for this Pt
41 .Q:'$D(^DGPT("B",SPN("DFN")))
42 .;-- Check every PTF record for this Pt for any SCI ICD-9 codes
43 .D CHKPTF
44 .Q
45 Q
46CHKPTF ;-- Called from GETICD, check all Transmitted PTF records for this patient to see if any contain SCI ICD-9 codes
47 S SPN("PTF_IEN")=0,SPN("ICD_FLG")=0
48 F S SPN("PTF_IEN")=$O(^DGPT("B",SPN("DFN"),SPN("PTF_IEN"))) Q:'+SPN("PTF_IEN")!(+SPN("ICD_FLG")) D
49 .;-- Quit if PTF record doesn't have STATUS=3 (Transmitted) or TYPE OF RECORD'=1 (PTF)
50 .I $P($G(^DGPT(SPN("PTF_IEN"),0)),U,6)'=3!($P($G(^(0)),U,11)'=1) Q
51 .;-- Look for SCI Dx codes, if SCI ICD-9 code found set flag (ICD_FLG=1)
52 .D CHKICD
53 .;-- If ICD_FLAG set to 1 then store into ^TMP($J,"SPNPM2","TOT_ICD",DFN) global
54 .I +$G(SPN("ICD_FLG")) S ^TMP($J,"SPNPM2","TOT_ICD",SPN("DFN"))="" ;W "I"
55 .Q
56 Q
57CHKICD ;-- Called from GETPTF and CHKPTF, check for matching SCI ICD-9 codes (in ICD temp global)
58 ;-- If SCI ICD-9 code found then set flag (ICD_FLG=1)
59 F SPN("PIECE")=10,11,16,17,18,19,20,21,22,23,24 D Q:+SPN("ICD_FLG")
60 .S SPN("ICDPT")=$P($G(^DGPT(SPN("PTF_IEN"),70)),U,SPN("PIECE"))
61 .I +SPN("ICDPT"),$D(^TMP($J,"SPNPMDX","SPNICD",SPN("ICDPT"))) S SPN("ICD_FLG")=1
62 .Q
63 Q
Note: See TracBrowser for help on using the repository browser.