source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLC.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1PXRMEXLC ; SLC/PKR/PJH - Routines to display repository entry components. ;08/03/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
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 . D REXL^PXRMLIST("PXRMEXLR")
10 . S VALMCNT=^TMP("PXRMEXLR",$J,"VALMCNT")
11 Q
12 ;
13 ;======================================================
14CDISP(IEN) ;Format component list for display.
15 N CAT,CMPNT,END,EOKTI,EXISTS,FILENUM,FOKTI,IND,INDEX,JND,JNDS,KND
16 N MSG,NCMPNT,NDLINE,NDSEL,NITEMS,NLINE,NSEL,PT01,START,TEMP,TEMP0,TYPE
17 K ^TMP("PXRMEXLC",$J),^TMP("PXRMEXLD",$J)
18 S (NDLINE,NLINE)=0
19 S (NDSEL,NSEL)=1
20 ;Load the description.
21 F IND=1:1:$P(^PXD(811.8,IEN,110,0),U,4) D
22 . S NLINE=NLINE+1
23 . S ^TMP("PXRMEXLC",$J,NLINE,0)=^PXD(811.8,IEN,110,IND,0)
24 . S ^TMP("PXRMEXLC",$J,"IDX",NLINE,NSEL)=""
25 S NLINE=NLINE+1
26 S ^TMP("PXRMEXLC",$J,NLINE,0)=" "
27 S ^TMP("PXRMEXLC",$J,"IDX",NLINE,NSEL)=""
28 S NCMPNT=^PXD(811.8,IEN,119)
29 ;Load the text for display.
30 F IND=1:1:NCMPNT D
31 . S NLINE=NLINE+1
32 . S TEMP=^PXD(811.8,IEN,120,IND,0)
33 . S ^TMP("PXRMEXLC",$J,NLINE,0)=$P(TEMP,U,1)
34 . S ^TMP("PXRMEXLC",$J,"IDX",NLINE,NSEL)=""
35 . S FILENUM=$P(TEMP,U,2)
36 . S FOKTI=$$FOKTI^PXRMEXFI(FILENUM)
37 . S NITEMS=$P(TEMP,U,3)
38 . I $P(TEMP,U,1)="REMINDER DIALOG" D
39 ..;Save details of the dialog in ^TMP("PXRMEXTMP")
40 .. S JNDS=NITEMS D DBUILD^PXRMEXLB(IND,NITEMS,FILENUM)
41 . E S JNDS=1
42 . F JND=JNDS:1:NITEMS D
43 .. S TEMP=^PXD(811.8,IEN,120,IND,1,JND,0)
44 .. S EOKTI=FOKTI
45 .. S PT01=$P(TEMP,U,1)
46 .. S EXISTS=$S(FILENUM=0:$$EXISTS^PXRMEXCF(PT01),1:$$EXISTS^PXRMEXIU(FILENUM,PT01,"W"))
47 ..;If this is an education topic and it starts with VA- it
48 ..;cannot be transported because of PCE's screen.
49 .. ;I (FILENUM=9999999.09)&(PT01["VA-") S EOKTI=0
50 ..;If this is a health factor see if it is a category.
51 .. S CAT=""
52 .. I (FILENUM=9999999.64) D
53 ... S TYPE=""
54 ... S START=$P(TEMP,U,2)
55 ... S END=$P(TEMP,U,3)
56 ... F KND=START:1:END D
57 .... S TEMP0=$P(^PXD(811.8,IEN,100,KND,0),";",3)
58 .... I $P(TEMP0,"~",1)=.1 S TYPE=$P(TEMP0,"~",2)
59 ... I TYPE="CATEGORY" S CAT="X"
60 .. S NLINE=NLINE+1
61 .. I IND=1,JND=1 S NSEL=1,INDEX=$S(EOKTI:NSEL,1:"")
62 .. E D
63 ...;If entries in this file are ok to install add them to the
64 ...;selectable list. Make sure the first selectable entry exists
65 ...;before incrementing NSEL.
66 ... I EOKTI S NSEL=$S($D(^TMP("PXRMEXLC",$J,"SEL",1)):NSEL+1,1:NSEL),INDEX=NSEL
67 ... E S INDEX=""
68 .. S ^TMP("PXRMEXLC",$J,NLINE,0)=$$FMTDATA(INDEX,PT01,CAT,EXISTS)
69 .. S ^TMP("PXRMEXLC",$J,"IDX",NLINE,NSEL)=""
70 ..;Store the file number, node 120 indexes and the ien if it exists.
71 .. I INDEX=NSEL S ^TMP("PXRMEXLC",$J,"SEL",NSEL)=FILENUM_U_IND_U_JND_U_EXISTS
72 . S NLINE=NLINE+1
73 . S ^TMP("PXRMEXLC",$J,NLINE,0)=""
74 . S ^TMP("PXRMEXLC",$J,"IDX",NLINE,NSEL)=""
75 Q
76 ;
77 ;======================================================
78FMTDATA(NSEL,PT01,CAT,EXISTS) ;Format items for display.
79 N NSTI,TEMP
80 S TEMP=$$RJ^XLFSTR(NSEL,4," ")_" "_$E(PT01,1,54)
81 I CAT="X" D
82 . S NSTI=63-$L(TEMP)
83 . S TEMP=TEMP_$$INSCHR(NSTI," ")_"X"
84 I EXISTS D
85 . S NSTI=75-$L(TEMP)
86 . S TEMP=TEMP_$$INSCHR(NSTI," ")_"X"
87 Q TEMP
88 ;
89 ;======================================================
90INSCHR(NUM,CHR) ;Return a string of NUM characters (CHR).
91 N IND,TEMP
92 S TEMP=""
93 I NUM<1 Q TEMP
94 F IND=1:1:NUM S TEMP=TEMP_CHR
95 Q TEMP
96 ;
97 ;======================================================
98ORDER(STRING,ORDER) ;Rebuild string in ascending or descending order.
99 N ARRAY,ITEM,CNT
100 F CNT=1:1 S ITEM=$P(STRING,",",CNT) Q:'ITEM S ARRAY(ITEM)=""
101 K STRING
102 F CNT=1:1 S ITEM=$O(ARRAY(ITEM),ORDER) Q:'ITEM D
103 .S $P(STRING,",",CNT)=ITEM
104 Q
105 ;
Note: See TracBrowser for help on using the repository browser.