source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXLC.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 6.8 KB
Line 
1PXRMEXLC ; SLC/PKR/PJH - Routines to display repository entry components. ;06/22/2004
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;======================================================
4BLDLIST(FORCE) ;Build a list of all repository entries.
5 ;If FORCE is true then force rebuilding of the list.
6 I FORCE K ^TMP("PXRMEXLR",$J)
7 I $D(^TMP("PXRMEXLR",$J,"VALMCNT")) S VALMCNT=^TMP("PXRMEXLR",$J,"VALMCNT")
8 E D
9 . N IEN,RELIST
10 . D RE^PXRMLIST(.RELIST,.IEN)
11 . M ^TMP("PXRMEXLR",$J)=RELIST
12 . S VALMCNT=RELIST("VALMCNT")
13 . F IND=1:1:VALMCNT S ^TMP("PXRMEXLR",$J,"IDX",IND,IND)=IEN(IND)
14 Q
15 ;
16 ;======================================================
17CDISP(IEN) ;Format component list for display.
18 N CAT,CMPNT,END,EOKTI,EXISTS,FILENUM,FOKTI,IND,INDEX,JND,JNDS,KND
19 N MSG,NCMPNT,NDLINE,NDSEL,NITEMS,NLINE,NSEL,PT01,START,TEMP,TEMP0,TYPE
20 K ^TMP("PXRMEXLC",$J),^TMP("PXRMEXLD",$J)
21 S (NDLINE,NLINE)=0
22 S (NDSEL,NSEL)=1
23 ;Load the description.
24 F IND=1:1:$P(^PXD(811.8,IEN,110,0),U,4) D
25 . S NLINE=NLINE+1
26 . S ^TMP("PXRMEXLC",$J,NLINE,0)=^PXD(811.8,IEN,110,IND,0)
27 . S ^TMP("PXRMEXLC",$J,"IDX",NLINE,NSEL)=""
28 S NLINE=NLINE+1
29 S ^TMP("PXRMEXLC",$J,NLINE,0)=" "
30 S ^TMP("PXRMEXLC",$J,"IDX",NLINE,NSEL)=""
31 S NCMPNT=^PXD(811.8,IEN,119)
32 ;Load the text for display.
33 F IND=1:1:NCMPNT D
34 . S NLINE=NLINE+1
35 . S TEMP=^PXD(811.8,IEN,120,IND,0)
36 . S ^TMP("PXRMEXLC",$J,NLINE,0)=$P(TEMP,U,1)
37 . S ^TMP("PXRMEXLC",$J,"IDX",NLINE,NSEL)=""
38 . S FILENUM=$P(TEMP,U,2)
39 . S FOKTI=$$FOKTI^PXRMEXFI(FILENUM)
40 . S NITEMS=$P(TEMP,U,3)
41 . I $P(TEMP,U,1)="REMINDER DIALOG" D
42 ..;Save details of the dialog in ^TMP("PXRMEXTMP")
43 .. S JNDS=NITEMS D DBUILD^PXRMEXLB(IND,NITEMS,FILENUM)
44 . E S JNDS=1
45 . F JND=JNDS:1:NITEMS D
46 .. S TEMP=^PXD(811.8,IEN,120,IND,1,JND,0)
47 .. S EOKTI=FOKTI
48 .. S PT01=$P(TEMP,U,1)
49 .. S EXISTS=$S(FILENUM=0:$$EXISTS^PXRMEXCF(PT01),1:$$EXISTS^PXRMEXIU(FILENUM,PT01,"W"))
50 ..;If this is an education topic and it starts with VA- it
51 ..;cannot be transported because of PCE's screen.
52 .. ;I (FILENUM=9999999.09)&(PT01["VA-") S EOKTI=0
53 ..;If this is a health factor see if it is a category.
54 .. S CAT=""
55 .. I (FILENUM=9999999.64) D
56 ... S TYPE=""
57 ... S START=$P(TEMP,U,2)
58 ... S END=$P(TEMP,U,3)
59 ... F KND=START:1:END D
60 .... S TEMP0=$P(^PXD(811.8,IEN,100,KND,0),";",3)
61 .... I $P(TEMP0,"~",1)=.1 S TYPE=$P(TEMP0,"~",2)
62 ... I TYPE="CATEGORY" S CAT="X"
63 .. S NLINE=NLINE+1
64 .. I IND=1,JND=1 S NSEL=1,INDEX=$S(EOKTI:NSEL,1:"")
65 .. E D
66 ...;If entries in this file are ok to install add them to the
67 ...;selectable list. Make sure the first selectable entry exists
68 ...;before incrementing NSEL.
69 ... I EOKTI S NSEL=$S($D(^TMP("PXRMEXLC",$J,"SEL",1)):NSEL+1,1:NSEL),INDEX=NSEL
70 ... E S INDEX=""
71 .. S ^TMP("PXRMEXLC",$J,NLINE,0)=$$FMTDATA(INDEX,PT01,CAT,EXISTS)
72 .. S ^TMP("PXRMEXLC",$J,"IDX",NLINE,NSEL)=""
73 ..;Store the file number, node 120 indexes and the ien if it exists.
74 .. I INDEX=NSEL S ^TMP("PXRMEXLC",$J,"SEL",NSEL)=FILENUM_U_IND_U_JND_U_EXISTS
75 . S NLINE=NLINE+1
76 . S ^TMP("PXRMEXLC",$J,NLINE,0)=""
77 . S ^TMP("PXRMEXLC",$J,"IDX",NLINE,NSEL)=""
78 Q
79 ;
80 ;======================================================
81DDISP(IND,NITEMS,FILENUM) ;Setup dialog display list.
82 N JND,NLINE,NSEL,TEMP
83 S (NLINE,NSEL)=0
84 F JND=1:1:NITEMS D
85 . S TEMP=^PXD(811.8,IEN,120,IND,1,JND,0)
86 . S PT01=$P(TEMP,U,1)
87 . S EXISTS=$$EXISTS^PXRMEXIU(FILENUM,PT01,"W")
88 . S NLINE=NLINE+1
89 . S NSEL=NSEL+1
90 . S ^TMP("PXRMEXLD",$J,NLINE,0)=$$FMTDATA(NSEL,PT01,CAT,EXISTS)
91 . S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
92 .;Store the file number, start and stop line in the repository.
93 . S ^TMP("PXRMEXLD",$J,"SEL",NSEL)=FILENUM_U_$P(TEMP,U,2,3)
94 Q
95 ;
96 ;======================================================
97FMTDATA(NSEL,PT01,CAT,EXISTS) ;Format items for display.
98 N NSTI,TEMP
99 S TEMP=$$RJ^XLFSTR(NSEL,4," ")_" "_$E(PT01,1,54)
100 I CAT="X" D
101 . S NSTI=63-$L(TEMP)
102 . S TEMP=TEMP_$$INSCHR(NSTI," ")_"X"
103 I EXISTS D
104 . S NSTI=75-$L(TEMP)
105 . S TEMP=TEMP_$$INSCHR(NSTI," ")_"X"
106 Q TEMP
107 ;
108 ;======================================================
109HISTLIST(LIST,VALMCNT) ;Build a list of install histories in
110 ;^TMP("PXRMEXIH",$J).
111 N DATE,DC,ENTRY,IHIND,IND,INDONE,NLINE,NSEL,RIEN,SOURCE,TEMP,USER
112 K ^TMP("PXRMEXIH",$J)
113 S (NLINE,NSEL)=0
114 S IND=""
115 F S IND=$O(LIST(IND)) Q:IND="" D
116 . S RIEN=^TMP("PXRMEXLR",$J,"IDX",IND,IND)
117 . I $D(^PXD(811.8,RIEN,130)) S INDONE=1
118 . E S INDONE=0
119 . S TEMP=^PXD(811.8,RIEN,0)
120 . S ENTRY=$P(TEMP,U,1)
121 . S SOURCE=$P(TEMP,U,2)
122 . S DATE=$P(TEMP,U,3)
123 . S NLINE=NLINE+1
124 . I INDONE S NSEL=NSEL+1
125 . S ^TMP("PXRMEXIH",$J,NLINE,0)=$$FRE^PXRMLIST(" ",ENTRY,SOURCE,DATE)
126 . I INDONE S ^TMP("PXRMEXIH",$J,"IDX",NLINE,NSEL)=""
127 . S NLINE=NLINE+1
128 . S ^TMP("PXRMEXIH",$J,NLINE,0)=" Installation Date Installed By"
129 . I INDONE S ^TMP("PXRMEXIH",$J,"IDX",NLINE,NSEL)=""
130 . S NLINE=NLINE+1
131 . S ^TMP("PXRMEXIH",$J,NLINE,0)=" ----------------- ------------"
132 . I INDONE S ^TMP("PXRMEXIH",$J,"IDX",NLINE,NSEL)=""
133 . I 'INDONE D Q
134 .. S NLINE=NLINE+1
135 .. S ^TMP("PXRMEXIH",$J,NLINE,0)=" none"
136 .. S NLINE=NLINE+1
137 .. S ^TMP("PXRMEXIH",$J,NLINE,0)=" "
138 . S DATE="",DC=0
139 . F S DATE=$O(^PXD(811.8,RIEN,130,"B",DATE)) Q:DATE="" D
140 .. S NLINE=NLINE+1
141 .. S DC=DC+1
142 .. I DC>1 S NSEL=NSEL+1
143 .. S IHIND=$O(^PXD(811.8,RIEN,130,"B",DATE,""))
144 .. S TEMP=^PXD(811.8,RIEN,130,IHIND,0)
145 .. S ^TMP("PXRMEXIH",$J,NLINE,0)=$$RJ^XLFSTR(NSEL,4," ")_" "_$$FMTE^XLFDT($P(TEMP,U,1),"5Z")_" "_$P(TEMP,U,2)
146 .. S ^TMP("PXRMEXIH",$J,"IDX",NLINE,NSEL)=""
147 .. S ^TMP("PXRMEXIH",$J,"SEL",NSEL)=RIEN_U_IHIND
148 . S NLINE=NLINE+1
149 . S ^TMP("PXRMEXIH",$J,NLINE,0)=" "
150 . S ^TMP("PXRMEXIH",$J,"IDX",NLINE,NSEL)=""
151 S VALMCNT=NLINE
152 Q
153 ;
154 ;======================================================
155INSCHR(NUM,CHR) ;Return a string of NUM characters (CHR).
156 N IND,TEMP
157 S TEMP=""
158 I NUM<1 Q TEMP
159 F IND=1:1:NUM S TEMP=TEMP_CHR
160 Q TEMP
161 ;
162 ;======================================================
163DREPL ;
164 N STR,I
165 K PXRMEXOR
166 S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
167 S STR="" F I=1:1:30 S STR=STR_"-"
168 S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J(STR_" REPLACEMENT ITEMS "_STR,79)
169DREPL1 ;
170 M ^TMP($J,"PXRMEXREP")=PXRMEXRP
171 K PXRMEXRP
172 ;S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="
173 N CNT,DLG,DDATA,DDLG,DEND,DNAM,DREP,DSTRT,IND,JND,LEV,TEMP
174 ;S LEV="" F S LEV=$O(^TMP($J,"PXRMEXREP",LEV)) Q:LEV="" D
175 S LEV=0
176 S DLG="" F S DLG=$O(^TMP($J,"PXRMEXREP",DLG)) Q:DLG="" D
177 .S DDATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",DLG)) Q:DDATA=""
178 .S DNAM=$P(DDATA,U),DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3) Q:DNAM=""
179 .I $D(PXRMEXOR(DNAM))>0 Q
180 .S PXRMEXOR(DNAM)=""
181 .S IND=$P(DDATA,U,4),JND=$P(DDATA,U,5)
182 .;Check if this component has been replaced
183 .S LEV=LEV+1
184 .S DREP=$G(PXRMNMCH(FILENUM,DNAM)) I DREP=DNAM S DREP=""
185 .;Save line in workfile
186 .S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
187 .S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
188 .D DLINE^PXRMEXLD(DNAM,LEV,"")
189 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAM)) D DCMP^PXRMEXLD(DNAM,LEV)
190 K ^TMP($J,"PXRMEXREP")
191 I $D(PXRMEXRP)>0 D DREPL1
192 Q
Note: See TracBrowser for help on using the repository browser.