| 1 | SPNPM2B ;SD/AB-PROGRAM MEASURE #2 (CONTINUATION) ;4/9/98
|
|---|
| 2 | ;;2.0;Spinal Cord Dysfunction;**6**;01/02/1997
|
|---|
| 3 | MAIN ;-- Called by MAIN^SPNPM2
|
|---|
| 4 | D ^SPNPMDX ;-- Collect SCI ICD-9 codes
|
|---|
| 5 | D GETPTF
|
|---|
| 6 | D GETICD
|
|---|
| 7 | EXIT ;
|
|---|
| 8 | Q
|
|---|
| 9 | GETPTF ;-- 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
|
|---|
| 33 | GETICD ;-- 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
|
|---|
| 46 | CHKPTF ;-- 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
|
|---|
| 57 | CHKICD ;-- 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
|
|---|
