source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPM4.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1SPNPM4 ;SD/AB,WDE-PROGRAM MEASURE #4 ;5/28/98
2 ;;2.0;Spinal Cord Dysfunction;**6,8**;01/02/1997
3MAIN ;-- This program will collect all SCD-R Pts who are SCD-CURRENTLY SERVED and registered on or before previous FY into the ^TMP($J,"SPNPM4","REGCS_FY",DFN) global
4 ;-- Other temp globals used or created are:
5 ;-- ^TMP($J,"SPNPMDX","SPNICD",DFN)
6 ;-- ^TMP($J,"SPNPM2","ALL_SCD",DFN)
7 ;-- ^TMP($J,"SPNPM2","TOT_ICD",DFN)
8 ;-- ^TMP($J,"SPNPM4","TOT_DENOM",DFN)
9 ;
10 ;-- SPN Variable Array list:
11 ;-- BEG_DT = Beginning Date (FOR loop)
12 ;-- DFN = DFN
13 ;-- END# = Ending number (ICD9)
14 ;-- END_DT = Ending Date (FOR loop)
15 ;-- EVAL_FLGO = Annual Rehab Evaluation Offered Flag
16 ;-- EVAL_FLGR = Annual Rehab Evaluation Received Flag
17 ;-- FY = Previous FY
18 ;-- I = Variable used in FOR Loop for ICD9 codes
19 ;-- ICDPT = Pointer from PTF file to ICD9 Dx file (#80)
20 ;-- ICD_FLG = ICD9 flag (set to 1 if SCI Dx found)
21 ;-- ICD_IEN = IEN in ICD9 Dx file (#80)
22 ;-- OFFRD_DT = Date Annual Rehab Eval Offered
23 ;-- ONSET_DT = SCD Date of Onset
24 ;-- PIECE = Piece in 70 node of PTF file (#45)
25 ;-- PTF_IEN = IEN in PTF file (#45)
26 ;-- RECVD_DT = Date Annual Rehab Eval Received
27 ;-- REG_DT = Registration Date
28 ;-- REG_STAT = Registration Status
29 ;-- REHAB_NODE = Annual Rehab Evaluation Node in ^SPNL(154,DFN,"REHAB")
30 ;-- ST# = Starting number for ICD9 code FOR Loop
31 ;-- TOT_CNT = Total # of All SCD Pts
32 ;-- TOT_CSREG = Total of SCD Pts who are CS and registered on or before End of Previous FY
33 ;-- TOT_DEN = Denominator Total for PM #4
34 ;-- TOT_NUM = Numerator Total for PM #4 (Offered and Received)
35 ;-- TOT_NUMO = Numerator Total for PM #4 (Offered)
36 ;-- TOT_NUMR = Numerator Total for PM #4 (Received)
37 ;
38 ;-- 1st get previous FY info
39 D GETYR^SPNPM2
40 D CHKALL
41 D CHKREG
42 D CHKICD
43 D GETDEN
44 ;-- Get PM #2 Numerator
45 D ^SPNPM4N
46 ;-- Put PM #2 totals into SPNTXT array
47 D SETTXT
48EXIT K SPN
49 K:$D(^TMP($J,"SPNPMDX")) ^("SPNPMDX")
50 K:$D(^TMP($J,"SPNPM2")) ^("SPNPM2")
51 K:$D(^TMP($J,"SPNPM4")) ^("SPNPM4")
52 Q
53CHKALL ;-- Check for existence of $D(^TMP($J,"SPNPM2","ALL_SCD")), create if necessary
54 I $D(^TMP($J,"SPNPM2","ALL_SCD")) Q
55 ;-- Otherwise create this temp global
56 D GETALL^SPNPM2
57 Q
58CHKREG ;-- Check to see if Pt in ^TMP($J,"SPNPM2","ALL_SCD",DFN) is registered on or before End of Given FY AND is SCD-CURRENTLY SERVED
59 ;-- Quit if '$D(^TMP($J,"SPNPM2","ALL_SCD"))
60 Q:'$D(^TMP($J,"SPNPM2","ALL_SCD"))
61 S (SPN("DFN"),SPN("TOT_CSREG"))=0
62 F S SPN("DFN")=$O(^TMP($J,"SPNPM2","ALL_SCD",SPN("DFN"))) Q:'+SPN("DFN") D
63 .;-- Get Registration Date (REG_DT) and Regisration Status (REG_STAT) of DFN
64 .S SPN("REG_DT")=$P($G(^SPNL(154,SPN("DFN"),0)),U,2),SPN("REG_STAT")=$P($G(^(0)),U,3)
65 .;-- Quit if REG_DT is null
66 .Q:'+SPN("REG_DT")
67 .;-- Quit if REG_DT '< END_DT and REG_STAT '= 1 (1=SCD-CURRENTLY SERVED)
68 .I SPN("REG_DT")>SPN("END_DT")!(SPN("REG_STAT")'=1) Q
69 .;-- Okay then save to ^TMP($J,"SPNPM4","REGCS_FY",DFN) global
70 .S ^TMP($J,"SPNPM4","REGCS_FY",SPN("DFN"))=SPN("REG_DT")_"^"_SPN("REG_STAT") S SPN("TOT_CSREG")=SPN("TOT_CSREG")+1
71 .Q
72 Q
73CHKICD ;-- Check for the existence of ^TMP($J,"SPNPM2","TOT_ICD"), if not exist then create
74 Q:$D(^TMP($J,"SPNPM2","TOT_ICD"))
75 ;-- Okay then create this temp global
76 D ^SPNPMDX,GETICD^SPNPM2B
77 Q
78GETDEN ;-- Get Denominator
79 ;-- Check if Pt (DFN) is in both ^TMP($J,"SPNPM4","REGCS_FY") ^TMP($J,"SPNPM2","TOT_ICD") globals
80 ;-- Quit if '$D(^TMP($J,"SPNPM2","ALL_SCD"))
81 Q:'$D(^TMP($J,"SPNPM2","ALL_SCD"))
82 ;-- Loop thru ^TMP($J,"SPNPM2","ALL_SCD",DFN) Pts, initialize Denominator counter (TOT_DEN)
83 S (SPN("DFN"),SPN("TOT_DEN"))=0
84 F S SPN("DFN")=$O(^TMP($J,"SPNPM2","ALL_SCD",SPN("DFN"))) Q:'+SPN("DFN") D
85 .I +$D(^TMP($J,"SPNPM4","REGCS_FY",SPN("DFN"))),+$D(^TMP($J,"SPNPM2","TOT_ICD",SPN("DFN"))) D
86 ..;-- Count and collect the Denominator
87 ..S SPN("TOT_DEN")=SPN("TOT_DEN")+1,^TMP($J,"SPNPM4","TOT_DENOM",SPN("DFN"))=""
88 ..Q
89 .Q
90 Q
91SETTXT ;-- Put PM #4 totals into SPNTXT array
92 I $G(SPNPARM("SITE"))="" S SPNPARM("SITE")=$G(^DD("SITE"))
93 S $P(SPNTXT(1),U,7)=0
94 ;
95 S $P(SPNTXT(1),U,1)=SPNPARM("SITE")
96 ;
97 ; Program Measure #4 Denominator = SPN("TOT_DEN")
98 S $P(SPNTXT(1),U,2)=SPN("TOT_DEN")
99 ;
100 ; Program Measure #4 Numerator (Offered and Received) = SPN("TOT_NUM")
101 S $P(SPNTXT(1),U,3)=SPN("TOT_NUM")
102 ;
103 ; Program Measure #4 Numerator (Offered) = SPN("TOT_NUMO")
104 S $P(SPNTXT(1),U,4)=SPN("TOT_NUMO")
105 ;
106 ; Program Measure #4 Numerator (Received) = SPN("TOT_NUMR")
107 S $P(SPNTXT(1),U,5)=SPN("TOT_NUMR")
108 ;
109 ; Total SCD-R Pts Currently Served by End of FY = SPN("TOT_CSREG")
110 S $P(SPNTXT(1),U,6)=SPN("TOT_CSREG")
111 ;
112 ; Total # ALL SCD-R Pts = SPN("TOT_CNT")
113 S $P(SPNTXT(1),U,7)=SPN("TOT_CNT")
114 ;
115 S SPNDESC="Program Measure 4 "_^DD("SITE")
116 D ^SPNMAIL
117 Q
Note: See TracBrowser for help on using the repository browser.