source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPM1N.m@ 949

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1SPNPM1N ;SD/AB-SCD PROGRAM MEASURE #1, GET THE NUMERATOR ;4/9/98
2 ;;2.0;Spinal Cord Dysfunction;**6**;01/02/1997
3MAIN ;-- Called from MAIN^SPNPM1
4 ;-- 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.
5 D TMPLOOP
6EXIT ;
7 Q
8TMPLOOP ;-- Loop thru ^TMP($J,"SPNPM1","DFN") and get total of all Pts who have a Primary Care Provider entered into the SCD-R file
9 ;-- Quit if ^TMP global not found
10 I '$D(^TMP($J,"SPNPM1","DFN")),'$D(^TMP($J,"SPNPMDX","SPNICD")) Q
11 S (SPN("DFN"),SPN("TOT_PC"))=0
12 F S SPN("DFN")=$O(^TMP($J,"SPNPM1","DFN",SPN("DFN"))) Q:'+SPN("DFN") D
13 .D PCCHK I +SPN("PC_FLG") S SPN("TOT_PC")=SPN("TOT_PC")+1
14 .Q
15 Q
16PCCHK ;-- 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
17 ;-- Inititalize Primary Care Provider Flag (PC_FLG)=0, set to 1 if PC Prrovider found
18 S SPN("PC_FLG")=0
19 Q:'$D(^SPNL(154,SPN("DFN"),"CARE")) ;-- Quit if no CARE node found
20 I +$P($G(^SPNL(154,SPN("DFN"),"CARE")),U) D
21 .S SPN("PROV#")=$P(^SPNL(154,SPN("DFN"),"CARE"),U) I SPN("PROV#")>0 D
22 ..;-- Check for valid Provider
23 ..I +$D(^VA(200,SPN("PROV#"),0)) D
24 ...;-- If valid PC Provider entered into SCD-R set PC_FLG=0
25 ...I $P($G(^VA(200,SPN("PROV#"),0)),U,11)="" S SPN("PC_FLG")=1
26 ...Q
27 ..Q
28 .Q
29 Q
Note: See TracBrowser for help on using the repository browser.