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