Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXLC.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXLC.m
r628 r636 1 PXRMEXLC ; SLC/PKR/PJH - Routines to display repository entry components. ;0 8/03/20072 ;;2.0;CLINICAL REMINDERS;**4 ,6**;Feb 04, 2005;Build 1231 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 3 ;====================================================== 4 4 BLDLIST(FORCE) ;Build a list of all repository entries. … … 7 7 I $D(^TMP("PXRMEXLR",$J,"VALMCNT")) S VALMCNT=^TMP("PXRMEXLR",$J,"VALMCNT") 8 8 E D 9 . D REXL^PXRMLIST("PXRMEXLR") 10 . S VALMCNT=^TMP("PXRMEXLR",$J,"VALMCNT") 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) 11 14 Q 12 15 ; … … 76 79 ; 77 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 ;====================================================== 78 97 FMTDATA(NSEL,PT01,CAT,EXISTS) ;Format items for display. 79 98 N NSTI,TEMP … … 88 107 ; 89 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 ;====================================================== 90 155 INSCHR(NUM,CHR) ;Return a string of NUM characters (CHR). 91 156 N IND,TEMP … … 96 161 ; 97 162 ;====================================================== 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 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 104 192 Q 105 ;
Note:
See TracChangeset
for help on using the changeset viewer.