30 lines
1.4 KiB
Mathematica
30 lines
1.4 KiB
Mathematica
SPNPM1N ;SD/AB-SCD PROGRAM MEASURE #1, GET THE NUMERATOR ;4/9/98
|
|
;;2.0;Spinal Cord Dysfunction;**6**;01/02/1997
|
|
MAIN ;-- Called from MAIN^SPNPM1
|
|
;-- This program will return PM #1 Numerator which is the number of people in the SCD-R who have a REGISTRATION STATUS of SCD-CURRENTLY SERVED by the end of FY 97 AND who have a Primary Care Provider entered in the SCD-R.
|
|
D TMPLOOP
|
|
EXIT ;
|
|
Q
|
|
TMPLOOP ;-- Loop thru ^TMP($J,"SPNPM1","DFN") and get total of all Pts who have a Primary Care Provider entered into the SCD-R file
|
|
;-- Quit if ^TMP global not found
|
|
I '$D(^TMP($J,"SPNPM1","DFN")),'$D(^TMP($J,"SPNPMDX","SPNICD")) Q
|
|
S (SPN("DFN"),SPN("TOT_PC"))=0
|
|
F S SPN("DFN")=$O(^TMP($J,"SPNPM1","DFN",SPN("DFN"))) Q:'+SPN("DFN") D
|
|
.D PCCHK I +SPN("PC_FLG") S SPN("TOT_PC")=SPN("TOT_PC")+1
|
|
.Q
|
|
Q
|
|
PCCHK ;-- Called from TMPLOOP, check to see if Pt has a PC Provider in file 154 (SCD-R file), and PC provider does NOT have a termination date in file 200, i.e. a valid provider
|
|
;-- Inititalize Primary Care Provider Flag (PC_FLG)=0, set to 1 if PC Prrovider found
|
|
S SPN("PC_FLG")=0
|
|
Q:'$D(^SPNL(154,SPN("DFN"),"CARE")) ;-- Quit if no CARE node found
|
|
I +$P($G(^SPNL(154,SPN("DFN"),"CARE")),U) D
|
|
.S SPN("PROV#")=$P(^SPNL(154,SPN("DFN"),"CARE"),U) I SPN("PROV#")>0 D
|
|
..;-- Check for valid Provider
|
|
..I +$D(^VA(200,SPN("PROV#"),0)) D
|
|
...;-- If valid PC Provider entered into SCD-R set PC_FLG=0
|
|
...I $P($G(^VA(200,SPN("PROV#"),0)),U,11)="" S SPN("PC_FLG")=1
|
|
...Q
|
|
..Q
|
|
.Q
|
|
Q
|