source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPEREX.m@ 814

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1VEPEREX ; MRM/DAOU - Computed findings for DOQIT extracts. ; 6/4/05 1:58pm
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;======================================================
5VISIT(DFN,NGET,BDAT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
6 ; Check to see if the patient has 2 or more visits after 18th
7 ; birthday and diagnosis.
8 N FIELDS,PAT,DOB,NAM,YR18,ALL,ERR,N,IDX,DAT
9 S FIELDS=".01;.03"
10 D GETS^DIQ(2,DFN,FIELDS,"I","PAT")
11 S DOB=PAT(2,DFN_",",.03,"I")
12 ;The calculation is to determine that the visit occurs on or
13 ;after the 18th bithday.
14 S YR18=DOB+180000-1
15 D LIST^DIC(9000010,,"","I",,,,,,,"ALL(1)","ERR")
16 I $D(ERR) S TEST(1)=0 Q
17 S N="",IDX=0 F S N=$O(ALL(1,"DILIST","ID",N)) Q:(N="")!(IDX=NGET) D
18 . Q:ALL(1,"DILIST","ID",N,.05)'=DFN
19 . S DAT=ALL(1,"DILIST",1,N)
20 . Q:YR18>DAT!(DAT<BDAT)!(DAT>EDT)
21 . S IDX=IDX+1,DATA(IDX)=ALL(1,"DILIST",2,N),TEST(IDX)=1,DATE(IDX)=DAT
22 . Q
23 S NFOUND=IDX S:'IDX TEST(1)=0
24 Q
25 ;
26CADPAT(DFN,TEST,DATE,DATA,TEXT) ;
27 ;Check to see if patient registered with DOQ-IT
28 N TYPE,FIELD
29 S TYPE="CAD",FIELD=.02 D PATREG
30 Q
31 ;
32DMPAT(DFN,TEST,DATE,DATA,TEXT) ;
33 ;Check to see if patient is registered for diabetes (DM) diagnosis
34 ;DOQIT topic.
35 N TYPE,FIELD
36 S TYPE="DM",FIELD=.03 D PATREG
37 Q
38 ;
39PCPAT(DFN,TEST,DATE,DATA,TEXT) ;
40 N TYPE,FIELD
41 S TYPE="PC",FIELD=.06 D PATREG
42 Q
43 ;
44HTNPAT(DFN,TEST,DATE,DATA,TEXT) ;
45 ;Chck to see if patient is registered for hypertension (HTN)
46 ;diagnosis DOQIT topic.
47 N TYPE,FIELD
48 S TYPE="HTN",FIELD=.04 D PATREG
49 Q
50 ;
51HFPAT(DFN,TEST,DATE,DATA,TEXT) ;
52 ;Check to see if a patient is registered for a heart failure (HF)
53 ;diagnosis DOQIT topic.
54 N TYPE,FIELD
55 S TYPE="HF",FIELD=.05 D PATREG
56 Q
57PATREG ;Get DOQ-IT registration or cancelation for clients.
58 S DATE=DT
59 D GETS^DIQ(19904.4,DFN,FIELD,"I","ARY","ERR")
60 I $D(ERR) S TEST=0,TEXT=$G(ERR("DIERR",1,"TEXT",1)) Q
61 S TEST=$S(ARY(19904.4,DFN_",",FIELD,"I")="R":1,1:0)
62 S DATA="",TEXT=""
63 Q
64CADLIST(NGET,BDT,EDT,PLIST,PARAM) ;
65 N TYPE,FIELD
66 S TYPE="CAD",FIELD=".01;.02" D PATLIST
67 Q
68HTNLIST(NGET,BDT,EDT,PLIST,PARAM) ;
69 N TYPE,FIELD
70 S TYPE="HTN",FIELD=".01;.04" D PATLIST
71 Q
72DMLIST(NGET,BDT,EDT,PLIST,PARAM) ;
73 N TYPE,FIELD
74 S TYPE="DM",FIELD=".01;.03" D PATLIST
75 Q
76HFLIST(NGET,BDT,EDT,PLIST,PARAM) ;
77 N TYPE,FIELD
78 S TYPE="HF",FIELD=".01;.05" D PATLIST
79 Q
80PCLIST(NGET,BDT,EDT,PLIST,PARAM) ;
81 N TYPE,FIELD
82 S TYPE="PC",FIELD=".01;.06" D PATLIST
83 Q
84PATLIST ;LIST OF PATIENTS REGISTERED FOR A PARTICULAR DIAGNOSIS
85 N ALL,ERR
86 S FLD=$P(FIELD,";",2)
87 D LIST^DIC(19904.4,,FIELD,"I",,,,,,,"ALL(1)","ERR")
88 I $D(ERR) S NGET=0 Q
89 S IDX=0,NGET=0
90 F S IDX=$O(ALL(1,"DILIST","ID",IDX)) Q:IDX="" D:($G(ALL(1,"DILIST","ID",IDX,FLD))'="")
91 . S NGET=NGET+1,DFN=ALL(1,"DILIST","ID",IDX,.01)
92 . S ^TMP($J,PLIST,DFN,1)="^^19904.4^.02^"_ALL(1,"DILIST","ID",IDX,FLD)
93 Q
Note: See TracBrowser for help on using the repository browser.