[628] | 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
|
---|