Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLC.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLC.m
r613 r623 1 PXRMEXLC ; 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 ;====================================================== 4 BLDLIST(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 ;====================================================== 14 CDISP(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 ;====================================================== 78 FMTDATA(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 ;====================================================== 90 INSCHR(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 ;====================================================== 98 ORDER(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 ; 1 PXRMEXLC ; SLC/PKR/PJH - Routines to display repository entry components. ;06/22/2004 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ;====================================================== 4 BLDLIST(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 ;====================================================== 17 CDISP(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 ;====================================================== 81 DDISP(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 ;====================================================== 97 FMTDATA(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 ;====================================================== 109 HISTLIST(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 ;====================================================== 155 INSCHR(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 ;====================================================== 163 DREPL ; 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) 169 DREPL1 ; 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 TracChangeset
for help on using the changeset viewer.
