1 | SPNPM4N ;SD/AB-PROGRAM MEASURE #4 NUMERATOR ;7/29/98
|
---|
2 | ;;2.0;Spinal Cord Dysfunction;**6,7**;01/01/1997
|
---|
3 | MAIN ;-- Called from MAIN^SPNPM4
|
---|
4 | ;-- This program will loop thru all SCD pts collected in the Denominator and count (for the Numerators Offered and Received) all Pts:
|
---|
5 | ;-- who are SCD-CURRENTLY SERVED
|
---|
6 | ;-- AND
|
---|
7 | ;-- who have received or been offered an ANNUAL REHAB EVALUATION
|
---|
8 | ;-- 1st loop thru ^SPNL(154,DFN) to get total of all SCD-R Pts
|
---|
9 | D LOOPSCD
|
---|
10 | D LOOPNUM
|
---|
11 | EXIT ;
|
---|
12 | Q
|
---|
13 | LOOPSCD ;-- Loop thru ^SPNL(154,DFN) to count Total # SCD-R Pts
|
---|
14 | S (SPN("DFN"),SPN("TOT_CNT"))=0
|
---|
15 | F S SPN("DFN")=$O(^SPNL(154,SPN("DFN"))) Q:'+SPN("DFN") D
|
---|
16 | .;-- Quit if no Zero node
|
---|
17 | .Q:'$D(^SPNL(154,SPN("DFN"),0))
|
---|
18 | .;-- Increment Total # SCD Pt counter (TOT_CNT)
|
---|
19 | .S SPN("TOT_CNT")=SPN("TOT_CNT")+1
|
---|
20 | .Q
|
---|
21 | Q
|
---|
22 | LOOPNUM ;-- Loop thru Denominator global ^TMP($J,"SPNPM4","TOT_DENOM",DFN)
|
---|
23 | S (SPN("DFN"),SPN("TOT_NUMO"),SPN("TOT_NUMR"),SPN("TOT_NUM"))=0
|
---|
24 | ;-- Quit if '$D(^TMP($J,"SPNPM4","TOT_DENOM"))
|
---|
25 | Q:'$D(^TMP($J,"SPNPM4","TOT_DENOM"))
|
---|
26 | F S SPN("DFN")=$O(^TMP($J,"SPNPM4","TOT_DENOM",SPN("DFN"))) Q:'+SPN("DFN") D
|
---|
27 | .;-- Now check to see if Pt has received or been offered an Annual Rehab Eval
|
---|
28 | .I $D(^SPNL(154,SPN("DFN"),"REHAB",0)) D CHKEVAL
|
---|
29 | .;-- If ANNUAL REHAB EVAL flag (EVAL_FLGO) set to 1 then increment Numerator Offered counter (TOT_NUMO)
|
---|
30 | .I +$G(SPN("EVAL_FLGO")) S SPN("TOT_NUMO")=SPN("TOT_NUMO")+1
|
---|
31 | .;-- If ANNUAL REHAB EVAL flag (EVAL_FLGR) set to 1 then increment Numerator Received counter (TOT_NUMR)
|
---|
32 | .I +$G(SPN("EVAL_FLGR")) S SPN("TOT_NUMR")=SPN("TOT_NUMR")+1
|
---|
33 | .;-- If BOTH EVAL_FLGO and EVAL_FLGR set then increment Numeratoer Offered and Received counter (TOT_NUM)
|
---|
34 | .I +$G(SPN("EVAL_FLGO"))&(+$G(SPN("EVAL_FLGR"))) S SPN("TOT_NUM")=SPN("TOT_NUM")+1
|
---|
35 | .Q
|
---|
36 | Q
|
---|
37 | CHKEVAL ;-- Check REHAB nodes to see if Pt Received or has been Offered an Annual Rehab Eval
|
---|
38 | S (SPN("REHAB_NODE"),SPN("EVAL_FLGO"),SPN("EVAL_FLGR"))=0
|
---|
39 | F S SPN("REHAB_NODE")=$O(^SPNL(154,SPN("DFN"),"REHAB",SPN("REHAB_NODE"))) Q:'+SPN("REHAB_NODE") D
|
---|
40 | .;-- Set Annual Rehab Eval Offered Date variable (OFFRD_DT) and Annual Rehab Eval Received Date variable (RECVD_DT)
|
---|
41 | .S SPN("OFFRD_DT")=+$P($G(^SPNL(154,SPN("DFN"),"REHAB",SPN("REHAB_NODE"),0)),U),SPN("RECVD_DT")=+$P($G(^SPNL(154,SPN("DFN"),"REHAB",SPN("REHAB_NODE"),0)),U,2)
|
---|
42 | .;-- Look to see if any ANNUAL REAHB EVAL OFFERED dates exists w/in previous FY, if so set ANNUAL REHAB EVAL flag (EVAL_FLGO) to 1
|
---|
43 | .I +SPN("OFFRD_DT")'<SPN("BEG_DT")&(SPN("OFFRD_DT")'>SPN("END_DT")) S SPN("EVAL_FLGO")=1
|
---|
44 | .;-- Look to see if any ANNUAL REHAB RECEIVED dates exists w/in previous FY, if so set ANNUAL REHAB EVAL flag (EVAL_FLGR) to 1
|
---|
45 | .I +SPN("RECVD_DT")'<SPN("BEG_DT")&(SPN("RECVD_DT")'>SPN("END_DT")) S SPN("EVAL_FLGR")=1
|
---|
46 | .Q
|
---|
47 | Q
|
---|