source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPXHR.m

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1GMTSPXHR ; SLC/SBW,KER - PCE Clinical Reminders/Maint ; 06/15/2005
2 ;;2.7;Health Summary;**8,22,23,28,34,56,63,75**;Oct 20, 1995;Build 21
3 ;
4 ; External References
5 ; DBIA 2182 MAIN^PXRM
6 ;
7MAIN ; Entry Point for Clinical Reminders
8 N CM,GMFLAG,HVET,HVDISP
9 S (HVET,CM)=0
10 I GMTSEGH["CR" S GMFLAG=0
11 I GMTSEGH["CRS" S GMFLAG=1
12 I GMTSEGH["CM" S GMFLAG=5,CM=1
13 I GMTSEGH["CMB" S GMFLAG=4,CM=1
14 I GMTSEGH["MHVD" S HVET=1,CM=1,HVDISP=11
15 I GMTSEGH["MHVS" S HVET=1,CM=1,HVDISP=10
16 Q:+$G(GMTSAGE)'>0!($G(SEX)="")!($G(DFN)'>0)
17 I HVET=1 D HVET Q
18 Q:$O(GMTSEG(GMTSEGN,811.9,0))'>0
19 N GMCR,GMFIRST,CRSEG,GMDISP
20 S GMCR=0,GMFIRST=1
21 F S GMCR=$O(GMTSEG(GMTSEGN,811.9,GMCR)) Q:'GMCR D Q:$D(GMTSQIT)
22 . S CRSEG=GMTSEG(GMTSEGN,811.9,GMCR)
23 . K ^TMP("PXRHM",$J),^TMP("PXRM",$J)
24 . D MAIN^PXRM(DFN,CRSEG,+$G(GMFLAG),1)
25 . D:+$D(^TMP("PXRHM",$J)) GETCR
26 I +$G(GMDISP)'>0 D CKP^GMTSUP Q:$D(GMTSQIT) W "Selected Clinical Reminders not due.",!
27 K ^TMP("PXRHM",$J),^TMP("PXRM",$J)
28 Q
29 ;
30HVET ;
31 N GMFIRST
32 K ^TMP("PXRHM",$J),^TMP("PXRMHV",$J)
33 S GMFIRST=1
34 D HS^PXRMHVET(DFN,HVDISP)
35 D:+$D(^TMP("PXRMHV",$J)) GETCRH
36 I +$G(GMDISP)'>0 D CKP^GMTSUP Q:$D(GMTSQIT) W "No Patient Reminders found.",!
37 K ^TMP("PXRHM",$J),^TMP("PXRMHV",$J)
38 Q
39 ;
40GETCR ; Get reminders that were returned
41 N ITEM,GMDT,GMN0,X,GMTSDAT,GMTSDUE,GMREM
42 I HVET=1 D GETCRH
43 S ITEM=0
44 F S ITEM=$O(^TMP("PXRHM",$J,ITEM)) Q:ITEM'>0 D Q:$D(GMTSQIT)
45 . S GMREM=""
46 . F S GMREM=$O(^TMP("PXRHM",$J,ITEM,GMREM)) Q:GMREM="" D CRDISP Q:$D(GMTSQIT)
47 Q
48 ;
49GETCRH ; Get Reminders that were returned for MyHealtheVet
50 N ITEM,GMDT,GMN0,X,GMTSDAT,GMTSDUE,GMREM,GMSTATUS
51 S GMSTATUS=""
52 F S GMSTATUS=$O(^TMP("PXRMHV",$J,GMSTATUS)) Q:GMSTATUS="" D Q:$D(GMTSQIT)
53 .S GMREM="" F S GMREM=$O(^TMP("PXRMHV",$J,GMSTATUS,GMREM)) Q:GMREM="" D Q:$D(GMTSQIT)
54 ..S ITEM=0 F S ITEM=$O(^TMP("PXRMHV",$J,GMSTATUS,GMREM,ITEM)) Q:ITEM'>0 D CRDISP Q:$D(GMTSQIT)
55 Q
56 ;
57CRDISP ; Display reminder data
58 N DUECOL,HIST,LASTCOL,STATUS,STATCOL,TYPE
59 I HVET=0 S GMN0=$G(^TMP("PXRHM",$J,ITEM,GMREM))
60 I HVET=1 S GMN0=$G(^TMP("PXRMHV",$J,GMSTATUS,GMREM,ITEM))
61 Q:GMN0']""
62 S STATUS=$P(GMN0,U,1)
63 S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDUE=X
64 S X=$P(GMN0,U,3) D REGDT4^GMTSU S GMTSDAT=X
65 S TYPE=$P(GMN0,U,4)
66 I TYPE["E" S HIST="(hist)"
67 I TYPE["X" S HIST="(exp)"
68 S GMDISP=1
69 D CKP^GMTSUP Q:$D(GMTSQIT)
70 I GMTSNPG D HDR,CKP^GMTSUP Q:$D(GMTSQIT)
71 I GMTSNPG D HDR
72 S STATCOL=41-($L(STATUS)/2)
73 S DUECOL=53-($L(GMTSDUE)/2)
74 S LASTCOL=67-($L(GMTSDAT)/2)
75 W GMREM,?STATCOL,STATUS,?DUECOL,GMTSDUE,?LASTCOL,GMTSDAT,?73,$G(HIST),!
76 I 'CM Q
77 ; Display activity data on reminder
78 I HVET=1 D HVETCM Q
79 ;;commented out the following because I believe it is outdated
80 ;S GMDT=0
81 ;F S GMDT=$O(^TMP("PXRHM",$J,ITEM,GMREM,GMDT)) Q:+GMDT'>0 D Q:$D(GMTSQIT)
82 ;. S GMN0=$G(^TMP("PXRHM",$J,ITEM,GMREM,GMDT))
83 ;. Q:GMN0']""
84 ;. I $P(GMN0,U,2) S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDAT=X
85 ;. D CKP^GMTSUP Q:$D(GMTSQIT)
86 ;. I GMTSNPG D HDR
87 ;. W ?5,$P(GMN0,U)," on record - ",$G(GMTSDAT),", ",$P(GMN0,U,3),!
88 ;; Display maintenance criteria for reminder
89 S GMDT=0
90 F S GMDT=$O(^TMP("PXRHM",$J,ITEM,GMREM,"TXT",GMDT)) Q:+GMDT'>0 D Q:$D(GMTSQIT)
91 . D CKP^GMTSUP Q:$D(GMTSQIT)
92 . I GMTSNPG D HDR
93 . W ?5,$G(^TMP("PXRHM",$J,ITEM,GMREM,"TXT",GMDT)),!
94 W !
95 Q
96HVETCM ;
97 ; Display maintenance criteria for reminder
98 S GMDT=0
99 F S GMDT=$O(^TMP("PXRMHV",$J,GMSTATUS,GMREM,ITEM,"TXT",GMDT)) Q:+GMDT'>0 D Q:$D(GMTSQIT)
100 . D CKP^GMTSUP Q:$D(GMTSQIT)
101 . I GMTSNPG D HDR
102 . W ?5,$G(^TMP("PXRMHV",$J,GMSTATUS,GMREM,ITEM,"TXT",GMDT)),!
103 W !
104 Q
105 ;
106HDR ; Header
107 I GMFIRST D FIRST Q:$D(GMTSQIT) S GMFIRST=0
108 W ?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",!
109 Q
110 ;
111FIRST ; Display Disclaimer
112 N GMREC
113 S GMREC=0
114 F S GMREC=$O(^TMP("PXRM",$J,"DISC",GMREC)) Q:+GMREC'>0 D Q:$D(GMTSQIT)
115 . D CKP^GMTSUP Q:$D(GMTSQIT)
116 . W ?1,$G(^TMP("PXRM",$J,"DISC",GMREC)),!
117 W !
118 Q
Note: See TracBrowser for help on using the repository browser.