PXRMG2E4 ;SLC/JVS -GEC #2 EXTRACT #4  ;7/14/05  08:11
 ;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
 Q
 ;
 Q
PROGRAM ; Extracts the IEN for the health factors that represents
 ; each of the home health programs.
 I $D(^AUTTHF("B","GEC ADULT DAY HEALTH CARE (REFERRED TO)")) D
 .S P441($O(^AUTTHF("B","GEC ADULT DAY HEALTH CARE (REFERRED TO)",0)))=""
 I $D(^AUTTHF("B","GEC HOMECARE FUNDING-VA")) D
 .S P449($O(^AUTTHF("B","GEC HOMECARE FUNDING-VA",0)))=""
 I $D(^AUTTHF("B","GEC HOMEMAKER/HOME HEALTH AIDE")) D
 .S P4410($O(^AUTTHF("B","GEC HOMEMAKER/HOME HEALTH AIDE",0)))=""
 I $D(^AUTTHF("B","GEC VA IN-HOME RESPITE")) D
 .S P4412($O(^AUTTHF("B","GEC VA IN-HOME RESPITE",0)))=""
 I $D(^AUTTHF("B","GEC HOME TELEHEALTH (REFERRED TO)")) D
 .S P451($O(^AUTTHF("B","GEC HOME TELEHEALTH (REFERRED TO)",0)))=""
 I $D(^AUTTHF("B","GEC TELEHEALTH FUNDING-VA")) D
 .S P452($O(^AUTTHF("B","GEC TELEHEALTH FUNDING-VA",0)))=""
 ;
CRITER1 ; Extracts the IEN for the health factors that represents
 ; the 8 ADL's
 I $D(^AUTTHF("B","GEC BATHING HELP/SUPERVISION LAST 7D-YES")) D
 .S C212($O(^AUTTHF("B","GEC BATHING HELP/SUPERVISION LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC BATHING PHYS ASST NEEDED LAST 7D-YES")) D
 .S C214($O(^AUTTHF("B","GEC BATHING PHYS ASST NEEDED LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC BED POSITIONING HELP LAST 7D-YES")) D
 .S C216($O(^AUTTHF("B","GEC BED POSITIONING HELP LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC DRESS HELP/SUPERVISION LAST 7D-YES")) D
 .S C218($O(^AUTTHF("B","GEC DRESS HELP/SUPERVISION LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC EATING HELP/SUPERVISION LAST 7D-YES")) D
 .S C2110($O(^AUTTHF("B","GEC EATING HELP/SUPERVISION LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC MOVING AROUND INDOORS LAST 7D-YES")) D
 .S C2114($O(^AUTTHF("B","GEC MOVING AROUND INDOORS LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC TOILET HELP/SUPERVISION LAST 7D-YES")) D
 .S C2118($O(^AUTTHF("B","GEC TOILET HELP/SUPERVISION LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC TRANSFERS HELP/SPRVISION LAST 7D-YES")) D
 .S C2120($O(^AUTTHF("B","GEC TRANSFERS HELP/SPRVISION LAST 7D-YES",0)))=""
 ;
CRITER2 ; Extracts the IEN for the health factors that represents
 ; the 8 "SIGNIFICANT COGNITIVE IMPARIMENT"
 I $D(^AUTTHF("B","GEC CAN BE UNDERSTOOD LAST 7D-NO")) D
 .S C221($O(^AUTTHF("B","GEC CAN BE UNDERSTOOD LAST 7D-NO",0)))=""
 I $D(^AUTTHF("B","GEC ENDANGERED SAFETY LAST 90D-YES")) D
 .S C224($O(^AUTTHF("B","GEC ENDANGERED SAFETY LAST 90D-YES",0)))=""
 I $D(^AUTTHF("B","GEC MADE REASONABLE DECISIONS LAST 7D-NO")) D
 .S C226($O(^AUTTHF("B","GEC MADE REASONABLE DECISIONS LAST 7D-NO",0)))=""
 I $D(^AUTTHF("B","GEC HALLUCINATIONS/DELUSIONS LAST 7D-YES")) D
 .S C272($O(^AUTTHF("B","GEC HALLUCINATIONS/DELUSIONS LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC PHYSICALLY ABUSIVE LAST 7D-YES")) D
 .S C274($O(^AUTTHF("B","GEC PHYSICALLY ABUSIVE LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC RESISTS CARE LAST 7D-YES")) D
 .S C276($O(^AUTTHF("B","GEC RESISTS CARE LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC VERBALLY ABUSIVE LAST 7D-YES")) D
 .S C278($O(^AUTTHF("B","GEC VERBALLY ABUSIVE LAST 7D-YES",0)))=""
 I $D(^AUTTHF("B","GEC WANDERING LAST 7D-YES")) D
 .S C2710($O(^AUTTHF("B","GEC WANDERING LAST 7D-YES",0)))=""
 ;
CRITER3 ; Extracts the IEN for the health factors that represents
 ; the 1 "Life expectancy < 6 months"
 I $D(^AUTTHF("B","GEC LIFE EXPECTANCY < 6MO-YES")) D
 .S C286($O(^AUTTHF("B","GEC LIFE EXPECTANCY < 6MO-YES",0)))=""
 ;
 ;Continued in PXRMG2E3