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
