64 lines
3.1 KiB
Mathematica
64 lines
3.1 KiB
Mathematica
SPNPM2B ;SD/AB-PROGRAM MEASURE #2 (CONTINUATION) ;4/9/98
|
|
;;2.0;Spinal Cord Dysfunction;**6**;01/02/1997
|
|
MAIN ;-- Called by MAIN^SPNPM2
|
|
D ^SPNPMDX ;-- Collect SCI ICD-9 codes
|
|
D GETPTF
|
|
D GETICD
|
|
EXIT ;
|
|
Q
|
|
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)
|
|
Q:'$D(^TMP($J,"SPNPM2","TOT_ONSET"))
|
|
S SPN("DFN")=0
|
|
F S SPN("DFN")=$O(^TMP($J,"SPNPM2","TOT_ONSET",SPN("DFN"))) Q:'+SPN("DFN") D
|
|
.S SPN("ONS_DT")=^TMP($J,"SPNPM2","TOT_ONSET",SPN("DFN"))
|
|
.Q:'$D(^DGPT("B",SPN("DFN")))
|
|
.S (SPN("PTF_IEN"),SPN("PTF_FLG"))=0
|
|
.F S SPN("PTF_IEN")=$O(^DGPT("B",SPN("DFN"),SPN("PTF_IEN"))) Q:'+SPN("PTF_IEN")!(+SPN("PTF_FLG")) D
|
|
..;-- Set PTF Admission Date (PTF_ADMDT) and Discharge Date (PTF_DCDT)
|
|
..S SPN("PTF_ADMDT")=$P($G(^DGPT(SPN("PTF_IEN"),0)),U,2),SPN("PTF_DCDT")=$P($G(^DGPT(SPN("PTF_IEN"),70)),U)
|
|
..Q:'+SPN("PTF_ADMDT")
|
|
..;-- check to see if PTF Admission Date is on or after Date of Onset and before SPN("END_DT")
|
|
..I SPN("PTF_ADMDT")'<SPN("ONS_DT")&(SPN("PTF_ADMDT")'>SPN("END_DT")) D
|
|
...;-- Okay, now check to make sure PTF record indicates a SCI/D Dx. quit otherwise
|
|
...S SPN("ICD_FLG")=0 D CHKICD I +SPN("ICD_FLG") D
|
|
....;-- Now make sure PTF Record has been Transmitted and Type=PTF, quit otherwise
|
|
....I $P($G(^DGPT(SPN("PTF_IEN"),0)),U,6)'=3&($P($G(^(0)),U,11)'=1) Q
|
|
....;-- Okay, then set into ^TMP($J,"SPNPM2","TOT_PTF",DFN)
|
|
....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"
|
|
....Q
|
|
...Q
|
|
..Q
|
|
.Q
|
|
Q
|
|
GETICD ;-- Get all SCD pts who have any ICD-9 codes in any PTF record
|
|
;-- Store into ^TMP($J,"SPNPM2","TOT_ICD",DFN) global
|
|
;-- Quit if '$D(^TMP($J,"SPNPM2","ALL_SCD"))
|
|
Q:'$D(^TMP($J,"SPNPM2","ALL_SCD"))
|
|
;-- Inititalze SPN("DFN")
|
|
S SPN("DFN")=0
|
|
F S SPN("DFN")=$O(^TMP($J,"SPNPM2","ALL_SCD",SPN("DFN"))) Q:'+SPN("DFN") D
|
|
.;-- Quit if no PTF record found for this Pt
|
|
.Q:'$D(^DGPT("B",SPN("DFN")))
|
|
.;-- Check every PTF record for this Pt for any SCI ICD-9 codes
|
|
.D CHKPTF
|
|
.Q
|
|
Q
|
|
CHKPTF ;-- Called from GETICD, check all Transmitted PTF records for this patient to see if any contain SCI ICD-9 codes
|
|
S SPN("PTF_IEN")=0,SPN("ICD_FLG")=0
|
|
F S SPN("PTF_IEN")=$O(^DGPT("B",SPN("DFN"),SPN("PTF_IEN"))) Q:'+SPN("PTF_IEN")!(+SPN("ICD_FLG")) D
|
|
.;-- Quit if PTF record doesn't have STATUS=3 (Transmitted) or TYPE OF RECORD'=1 (PTF)
|
|
.I $P($G(^DGPT(SPN("PTF_IEN"),0)),U,6)'=3!($P($G(^(0)),U,11)'=1) Q
|
|
.;-- Look for SCI Dx codes, if SCI ICD-9 code found set flag (ICD_FLG=1)
|
|
.D CHKICD
|
|
.;-- If ICD_FLAG set to 1 then store into ^TMP($J,"SPNPM2","TOT_ICD",DFN) global
|
|
.I +$G(SPN("ICD_FLG")) S ^TMP($J,"SPNPM2","TOT_ICD",SPN("DFN"))="" ;W "I"
|
|
.Q
|
|
Q
|
|
CHKICD ;-- Called from GETPTF and CHKPTF, check for matching SCI ICD-9 codes (in ICD temp global)
|
|
;-- If SCI ICD-9 code found then set flag (ICD_FLG=1)
|
|
F SPN("PIECE")=10,11,16,17,18,19,20,21,22,23,24 D Q:+SPN("ICD_FLG")
|
|
.S SPN("ICDPT")=$P($G(^DGPT(SPN("PTF_IEN"),70)),U,SPN("PIECE"))
|
|
.I +SPN("ICDPT"),$D(^TMP($J,"SPNPMDX","SPNICD",SPN("ICDPT"))) S SPN("ICD_FLG")=1
|
|
.Q
|
|
Q
|