source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMG2E4.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1PXRMG2E4 ;SLC/JVS -GEC #2 EXTRACT #4 ;7/14/05 08:11
2 ;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
3 Q
4 ;
5 Q
6PROGRAM ; Extracts the IEN for the health factors that represents
7 ; each of the home health programs.
8 I $D(^AUTTHF("B","GEC ADULT DAY HEALTH CARE (REFERRED TO)")) D
9 .S P441($O(^AUTTHF("B","GEC ADULT DAY HEALTH CARE (REFERRED TO)",0)))=""
10 I $D(^AUTTHF("B","GEC HOMECARE FUNDING-VA")) D
11 .S P449($O(^AUTTHF("B","GEC HOMECARE FUNDING-VA",0)))=""
12 I $D(^AUTTHF("B","GEC HOMEMAKER/HOME HEALTH AIDE")) D
13 .S P4410($O(^AUTTHF("B","GEC HOMEMAKER/HOME HEALTH AIDE",0)))=""
14 I $D(^AUTTHF("B","GEC VA IN-HOME RESPITE")) D
15 .S P4412($O(^AUTTHF("B","GEC VA IN-HOME RESPITE",0)))=""
16 I $D(^AUTTHF("B","GEC HOME TELEHEALTH (REFERRED TO)")) D
17 .S P451($O(^AUTTHF("B","GEC HOME TELEHEALTH (REFERRED TO)",0)))=""
18 I $D(^AUTTHF("B","GEC TELEHEALTH FUNDING-VA")) D
19 .S P452($O(^AUTTHF("B","GEC TELEHEALTH FUNDING-VA",0)))=""
20 ;
21CRITER1 ; Extracts the IEN for the health factors that represents
22 ; the 8 ADL's
23 I $D(^AUTTHF("B","GEC BATHING HELP/SUPERVISION LAST 7D-YES")) D
24 .S C212($O(^AUTTHF("B","GEC BATHING HELP/SUPERVISION LAST 7D-YES",0)))=""
25 I $D(^AUTTHF("B","GEC BATHING PHYS ASST NEEDED LAST 7D-YES")) D
26 .S C214($O(^AUTTHF("B","GEC BATHING PHYS ASST NEEDED LAST 7D-YES",0)))=""
27 I $D(^AUTTHF("B","GEC BED POSITIONING HELP LAST 7D-YES")) D
28 .S C216($O(^AUTTHF("B","GEC BED POSITIONING HELP LAST 7D-YES",0)))=""
29 I $D(^AUTTHF("B","GEC DRESS HELP/SUPERVISION LAST 7D-YES")) D
30 .S C218($O(^AUTTHF("B","GEC DRESS HELP/SUPERVISION LAST 7D-YES",0)))=""
31 I $D(^AUTTHF("B","GEC EATING HELP/SUPERVISION LAST 7D-YES")) D
32 .S C2110($O(^AUTTHF("B","GEC EATING HELP/SUPERVISION LAST 7D-YES",0)))=""
33 I $D(^AUTTHF("B","GEC MOVING AROUND INDOORS LAST 7D-YES")) D
34 .S C2114($O(^AUTTHF("B","GEC MOVING AROUND INDOORS LAST 7D-YES",0)))=""
35 I $D(^AUTTHF("B","GEC TOILET HELP/SUPERVISION LAST 7D-YES")) D
36 .S C2118($O(^AUTTHF("B","GEC TOILET HELP/SUPERVISION LAST 7D-YES",0)))=""
37 I $D(^AUTTHF("B","GEC TRANSFERS HELP/SPRVISION LAST 7D-YES")) D
38 .S C2120($O(^AUTTHF("B","GEC TRANSFERS HELP/SPRVISION LAST 7D-YES",0)))=""
39 ;
40CRITER2 ; Extracts the IEN for the health factors that represents
41 ; the 8 "SIGNIFICANT COGNITIVE IMPARIMENT"
42 I $D(^AUTTHF("B","GEC CAN BE UNDERSTOOD LAST 7D-NO")) D
43 .S C221($O(^AUTTHF("B","GEC CAN BE UNDERSTOOD LAST 7D-NO",0)))=""
44 I $D(^AUTTHF("B","GEC ENDANGERED SAFETY LAST 90D-YES")) D
45 .S C224($O(^AUTTHF("B","GEC ENDANGERED SAFETY LAST 90D-YES",0)))=""
46 I $D(^AUTTHF("B","GEC MADE REASONABLE DECISIONS LAST 7D-NO")) D
47 .S C226($O(^AUTTHF("B","GEC MADE REASONABLE DECISIONS LAST 7D-NO",0)))=""
48 I $D(^AUTTHF("B","GEC HALLUCINATIONS/DELUSIONS LAST 7D-YES")) D
49 .S C272($O(^AUTTHF("B","GEC HALLUCINATIONS/DELUSIONS LAST 7D-YES",0)))=""
50 I $D(^AUTTHF("B","GEC PHYSICALLY ABUSIVE LAST 7D-YES")) D
51 .S C274($O(^AUTTHF("B","GEC PHYSICALLY ABUSIVE LAST 7D-YES",0)))=""
52 I $D(^AUTTHF("B","GEC RESISTS CARE LAST 7D-YES")) D
53 .S C276($O(^AUTTHF("B","GEC RESISTS CARE LAST 7D-YES",0)))=""
54 I $D(^AUTTHF("B","GEC VERBALLY ABUSIVE LAST 7D-YES")) D
55 .S C278($O(^AUTTHF("B","GEC VERBALLY ABUSIVE LAST 7D-YES",0)))=""
56 I $D(^AUTTHF("B","GEC WANDERING LAST 7D-YES")) D
57 .S C2710($O(^AUTTHF("B","GEC WANDERING LAST 7D-YES",0)))=""
58 ;
59CRITER3 ; Extracts the IEN for the health factors that represents
60 ; the 1 "Life expectancy < 6 months"
61 I $D(^AUTTHF("B","GEC LIFE EXPECTANCY < 6MO-YES")) D
62 .S C286($O(^AUTTHF("B","GEC LIFE EXPECTANCY < 6MO-YES",0)))=""
63 ;
64 ;Continued in PXRMG2E3
Note: See TracBrowser for help on using the repository browser.