source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPM1.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: 3.9 KB
Line 
1SPNPM1 ;SD/AB,WDE-PROGRAM MEASURE #1 ;5/28/98
2 ;;2.0;Spinal cord Dysfunction;**6,8**;01/02/1997
3MAIN ;-- This programs main purpose is to retrieve the number of SCD Pts who are SCD-CURRENTLY SERVED by the end of Previous FY and who have any SCI ICD-9 code in a Transmitted PTF record (DENOMINATOR)
4 ;-- It also gets the number of SCD-CURRENTLY SERVED Pts (CS by the end of Previous FY) who also have a Primary Care Provider entered into the respective SCD-R records (NUMERATOR)
5 ;-- Variable array (SPN) list:
6 ;-- DFN = DFN
7 ;-- END# = Ending ICD-9 code
8 ;-- END_DT = FM-format Ending Date (Last Day of FY)
9 ;-- FY = FY (2-digit) used for data calculations
10 ;-- I = As FOR Loop parameter for get range of ICD-9 codes
11 ;-- ICD_FLG = ICD FLAG (set to 1 if SCI ICD-9 code found)
12 ;-- ICD_IEN = IEN in ^ICD9( global
13 ;-- ICDPT = SCI ICD-9 Pointer in ^TMP($J,"SPNPMDX","SPNICD") global
14 ;-- PC_FLG = Primary Care flag (set to 1 if PC Provider found in SCD-R record)
15 ;-- PIECE = Piece containing ICD-9 pointers in ^DGPT(PTF_IEN,70)
16 ;-- PROV# = Provider pointer to ^VA(200)
17 ;-- PTF_IEN = PTF IEN
18 ;-- REG_DT = SCD-R REGISTRATION DATE
19 ;-- REG_STAT = SCD-R REGISTRATION STATUS
20 ;-- ST# = Starting ICD-9 code
21 ;-- TOT_CSREG = Total # SCD CS Pts Registered by end of FY
22 ;-- TOT_NO_ICD = Total # SCD CS Pts Registered by end of FY w/o matching SCI ICD-9 codes in any Transmitted PTF record
23 ;-- TOT_NO_PTF = Total # SCD CS Pts Registered by end of FY w/o any PTF record
24 ;-- TOT_PC = Total # SCD CS Pts Registered by end of FY with PC Provider entered into SCD-R
25 ;-- TOT_PTF = Total # SCD CS Pts Registered by end of FY with matching SCI ICD-9 codes in any Transmitted PTF record
26 ;-- TOT_PTS = Grand Total of ALL SCD Pts in SCD-R
27 K:$D(^TMP($J)) ^($J)
28 D GETYR
29 D GETSCD
30 ;-- Get SCI ICD-9 codes
31 D ^SPNPMDX
32 ;-- Get DENOMINATOR of PM #1
33 D ^SPNPM1D
34 ;-- Get NUMERATOR of PM #1
35 D ^SPNPM1N
36 ;-- Put PM #1 totals into SPNTXT array
37 D SETTXT
38EXIT K SPN
39 K:$D(^TMP($J)) ^($J)
40 Q
41GETYR ;-- Get FY for previous FY, and set Ending Date (END_DT) to FM FY_0930
42 I +$E($G(DT),4,7)<931 S SPN("FY")=$E($G(DT),1,3)-1
43 E S SPN("FY")=$E($G(DT),1,3)
44 S SPN("END_DT")=+SPN("FY")_"0930"
45 Q
46GETSCD ;-- Loop thru SCD Registry file (^SPNL(154)) and get all SCD Pts who are Registered and Curr Served (CS) by end of Previous FY
47 S (SPN("DFN"),SPN("TOT_CSREG"),SPN("TOT_PTS"))=0
48 F S SPN("DFN")=$O(^SPNL(154,SPN("DFN"))) Q:'+SPN("DFN") D
49 .;-- Quit if no zero node
50 .Q:'$D(^SPNL(154,SPN("DFN"),0))
51 .;-- Increment Total # SCD Pts (TOT_PTS)
52 .S SPN("TOT_PTS")=SPN("TOT_PTS")+1
53 .S SPN("REG_DT")=$P($G(^SPNL(154,SPN("DFN"),0)),U,2),SPN("REG_STAT")=$P($G(^(0)),U,3)
54 .;-- Quit if REG_DT null
55 .Q:'+SPN("REG_DT")
56 .;-- Quit if REG_DT '< END_DT and/or REG_STAT '=1 (SCD-Curr Served)
57 .I SPN("REG_DT")>SPN("END_DT")!(SPN("REG_STAT")'=1) Q
58 .;-- Okay, then save to ^TMP global
59 .S ^TMP($J,"SPNPM1","DFN",SPN("DFN"))="" S SPN("TOT_CSREG")=SPN("TOT_CSREG")+1
60 .Q
61 Q
62SETTXT ;-- Set up SPNTXT message text array
63 I $G(SPNPARM("SITE"))="" S SPNPARM("SITE")=$G(^DD("SITE"))
64 S $P(SPNTXT(1),U,7)=""
65 S $P(SPNTXT(1),U,1)=SPNPARM("SITE")
66 ;
67 ; Total # of CS SCD-R Pts Registered by End of FY with matching
68 ; SCI ICD-9 codes in any Transmitted PTF Record = SPN("TOT_PTF")
69 ; *** This is PM #1 DENOMINATOR ***
70 S $P(SPNTXT(1),U,2)=SPN("TOT_PTF")
71 ;
72 ; Total # of All SCD-R Pts /w PC Provider Entered into
73 ; SCD-R = SPN("TOT_PC")
74 ; *** This is PM #1 NUMERATOR ***
75 S $P(SPNTXT(1),U,3)=SPN("TOT_PC")
76 ;
77 ; Total # of SCD-R Pts Registered by End of FY w/o^ matching SCI
78 ; ICD-9 codes in any Transmitted PTF Record = SPN("TOT_NO_ICD")
79 S $P(SPNTXT(1),U,4)=SPN("TOT_NO_ICD")
80 ;
81 ; Total CS SCD-R Pts Registered by End of FY w/o any
82 ; PTF record = SPN("TOT_NO_PTF")
83 S $P(SPNTXT(1),U,5)=SPN("TOT_NO_PTF")
84 ;
85 ; Total # of CS SCD-R Pts Registered by End of FY = SPN("TOT_CSREG")
86 S $P(SPNTXT(1),U,6)=SPN("TOT_CSREG")
87 ;
88 ; Total # of All SCD-R Pts = SPN("TOT_PTS")
89 S $P(SPNTXT(1),U,7)=SPN("TOT_PTS")
90 ;
91 S SPNDESC="Program Measure 1 "_$G(^DD("SITE"))
92 D ^SPNMAIL
93 Q
Note: See TracBrowser for help on using the repository browser.