source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPM4N.m@ 847

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1SPNPM4N ;SD/AB-PROGRAM MEASURE #4 NUMERATOR ;7/29/98
2 ;;2.0;Spinal Cord Dysfunction;**6,7**;01/01/1997
3MAIN ;-- 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
11EXIT ;
12 Q
13LOOPSCD ;-- 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
22LOOPNUM ;-- 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
37CHKEVAL ;-- 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
Note: See TracBrowser for help on using the repository browser.