Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLB.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/PXRMEXLB.m
r613 r623 1 PXRMEXLB ;SLC/PJH - Reminder Dialog Exchange. ;05/16/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ; 4 ;===================================================================== 5 ; 6 ;Build list of dialog components - called once from PXRMEXLC 7 ;------------------------------- 8 DBUILD(IND,NITEMS,FILENUM) ; 9 N DARRAY,DDATA,DDLG,DEND,DLOC,DMAP,DNAM,DNODE,DSEQ,DSTRT,DSUB,FILE,JND 10 N REPCNT,RESGRP,TEMPRESL,CNT 11 ; 12 K ^TMP("PXRMEXTMP",$J),^TMP("PXRMEXFND",$J) 13 ; 14 ;Scan dialog components in 120 and save name and type 15 S JND=0 16 F S JND=$O(^PXD(811.8,IEN,120,IND,1,JND)) Q:'JND D 17 .S DDATA=$G(^PXD(811.8,IEN,120,IND,1,JND,0)) Q:DDATA="" 18 .S DNAM=$P(DDATA,U),DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3) 19 .;Extract dialog type and text and findings from exchange file 20 .D DPARSE 21 ;Scan dialog components in 120 and save dialog links 22 S JND="B",REPCNT=0 23 F S JND=$O(^PXD(811.8,IEN,120,IND,1,JND),-1) Q:'JND D 24 .S DDATA=$G(^PXD(811.8,IEN,120,IND,1,JND,0)) Q:DDATA="" 25 .S DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3) 26 .S DDLG=$P(DDATA,U),DSUB=DSTRT+2 27 .I JND=NITEMS D 28 ..S ^TMP("PXRMEXTMP",$J,"PXRMDNAM")=DDLG 29 ..I $P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3)'["100~NATIONAL" Q 30 ..S ^TMP("PXRMEXTMP",$J,"PXRMDNAT")="" 31 .F S DSUB=$O(^PXD(811.8,IEN,100,DSUB)) Q:DSUB>DEND D 32 ..S DNODE=$G(^PXD(811.8,IEN,100,DSUB,0)) 33 ..I ($P(DNODE,";")'="801.412")&($P(DNODE,";")'="801.41121")&($P(DNODE,";",3)'["118~") Q 34 ..S FILE=$P(DNODE,";") 35 ..S DNODE=$P(DNODE,";",3) 36 ..;;Modified Exchange to handle dialogs with replacement dialogs 37 ..I $E(DNODE,1,4)="118~" D 38 ...S DNAM=$P(DNODE,"~",2) Q:DNAM="" 39 ...S DLOC=$G(^TMP("PXRMEXTMP",$J,"DLOC",DNAM)) 40 ...S REPCNT=REPCNT+1,^TMP("PXRMEXTMP",$J,"DREPL",REPCNT,DDLG)=DNAM_U_DLOC 41 ..I $E(DNODE,1,4)'=".01~" Q 42 ..S DSEQ=$P(DNODE,"~",2) Q:DSEQ="" 43 ..I FILE="801.41121" D Q 44 ...S DNAM=$P(DNODE,"~",2) Q:DNAM="" 45 ...S DLOC=$G(^TMP("PXRMEXTMP",$J,"DLOC",DNAM)) 46 ...S CNT=0 47 ...I $D(^TMP("PXRMEXTMP",$J,"DMAP",DDLG))>0 S CNT=$O(^TMP("PXRMEXTMP",$J,"DMAP",DDLG,""),-1) 48 ...S ^TMP("PXRMEXTMP",$J,"DMAP",DDLG,CNT+1)=DNAM_U_DLOC 49 ..S DNODE=$G(^PXD(811.8,IEN,100,DSUB+1,0)) 50 ..I ($P(DNODE,";")'="801.412") Q 51 ..S DNODE=$P(DNODE,";",3) I $E(DNODE,1,2)'="2~" Q 52 ..S DNAM=$P(DNODE,"~",2) Q:DNAM="" 53 ..S DLOC=$G(^TMP("PXRMEXTMP",$J,"DLOC",DNAM)) 54 ..S ^TMP("PXRMEXTMP",$J,"DMAP",DDLG,DSEQ)=DNAM_U_DLOC 55 ; 56 ;Build index of dialog findings by name 57 N FDATA,FILENAM,FILENUM,FNAME 58 S IND=0 59 F S IND=$O(^PXD(811.8,IEN,120,IND)) Q:'IND D 60 .S FDATA=$G(^PXD(811.8,IEN,120,IND,0)) Q:FDATA="" 61 .S FILENAM=$P(FDATA,U),FILENUM=$P(FDATA,U,2) Q:FILENAM="" Q:'FILENUM 62 .;Ignore reminder dialogs 63 .I FILENAM="REMINDER DIALOG" Q 64 .;Ignore reminder terms 65 .I FILENAM="REMINDER TERM" Q 66 .;Strip off trailing S in finding file name 67 .I $E(FILENAM,$L(FILENAM))="S" S $E(FILENAM,$L(FILENAM))="" 68 .S JND=0 69 .F S JND=$O(^PXD(811.8,IEN,120,IND,1,JND)) Q:'JND D 70 ..S FNAME=$P($G(^PXD(811.8,IEN,120,IND,1,JND,0)),U) Q:FNAME="" 71 ..;Save entry 72 ..S ^TMP("PXRMEXFND",$J,FNAME)=FILENUM_U_FILENAM_U_IND 73 I $D(TEMPRESL)>0 D 74 .S DDLG="" F S DDLG=$O(TEMPRESL(DDLG)) Q:DDLG="" D 75 ..;S ^TMP("PXRMEXTMP",$J,"RESULT",DDLG,TEMPRESL(DDLG))="" 76 ..S DSEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",DDLG,""),-1) 77 ..S ^TMP("PXRMEXTMP",$J,"DMAP",DDLG,DSEQ+1)=TEMPRESL(DDLG)_U_RESGRP(TEMPRESL(DDLG)) 78 Q 79 ; 80 ;Scan exchange file to get dialog fields 81 ;--------------------------------------- 82 DPARSE N DCNT,DFIND,DFIAD,DFNAM,DFQUIT,DLCT,DLINES,DSUB,DTEXT,DTXT,DTYP 83 ; 84 ;Find where all the field numbers are kept 85 N DARRAY,DDATA,DFNUM,DRAW,DSTRING,RESNAM 86 S DSUB=DSTRT-1,DSTRING=";.01;4;5;15;24;25;55;" 87 ;S DSUB=DSTRT,DSTRING=";4;5;15;24;25;" 88 F S DSUB=$O(^PXD(811.8,IEN,100,DSUB)) Q:'DSUB D Q:DSUB>DEND 89 .S DDATA=$G(^PXD(811.8,IEN,100,DSUB,0)) Q:DDATA="" 90 .I $P(DDATA,";")'=801.41 Q 91 .S DFNUM=$P(DDATA,";",3),DFNUM=$P(DFNUM,"~") Q:DFNUM="" 92 .I DSTRING[(";"_DFNUM_";") S DARRAY(DFNUM)=DSUB 93 .I $P(DDATA,";")="801.41121" S DARRAY(55)=DSUB 94 ; 95 ;Determine dialog component type 96 S DSUB=DARRAY(4) Q:'DSUB 97 S DTYP=$P($G(^PXD(811.8,IEN,100,DSUB,0)),"~",2) 98 I DTYP'["result" S:DTYP[" " DTYP=$P(DTYP," ",2) S:DTYP="value" DTYP="forced" 99 ; 100 ;Initialise text and finding fields 101 S DTXT="*NONE*",DFIND="" 102 ;Get text appropriate for the type of component 103 I ((DTYP="element")!(DTYP="group"))&(DTYP'["result") D 104 .;search for WP text 105 .S DSUB=$G(DARRAY(25)) D:DSUB 106 ..S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT="" 107 ..;Get the line count 108 ..S DLINES=$P(DTEXT,"~",3),DCNT=0 109 ..;Get the wp text lines 110 ..F DLCT=DSUB+1:1:DSUB+DLINES D 111 ...S DTEXT=$G(^PXD(811.8,IEN,100,DLCT,0)) 112 ...S DCNT=DCNT+1,DTXT(DCNT)=DTEXT 113 ...;Check for embedded TIU templates 114 ...D DTIU(DNAM,DTEXT) 115 ..;Reformat text to 50 characters 116 ..D DWP(.DTXT) 117 ..;Search for Result Group/Element 118 ..S DSUB=$G(DARRAY(55)) I DSUB>0 D 119 ...S RESNAME=$P($P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3),"~",2) 120 ...S TEMPRESL(DNAM)=RESNAME 121 .;Search for finding item 122 .S DSUB=$G(DARRAY(15)) D:DSUB 123 ..S DFIND=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DFIND="" 124 ..;Finding name 125 ..S DFIND=$P(DFIND,"~",2) Q:DFIND="" 126 ..I $P(DFIND,".")="ICD9" S DFIND=$P(DFIND," ") 127 .; 128 .;Search for additional finding - start after WP text 129 .S DSUB=+$G(DARRAY(25)) D:DSUB 130 ..S DCNT=0,DFQUIT=0 131 ..F DLCT=DSUB+1+DLINES:1 D Q:DFQUIT Q:DLCT>DEND 132 ...S DTEXT=$G(^PXD(811.8,IEN,100,DLCT,0)) 133 ...;Ignore line if this is not an additional finding 134 ...I $P(DTEXT,";")'=801.4118 S:$P(DTEXT,";")>801.4118 DFQUIT=1 Q 135 ...S DFNAM=$P(DTEXT,"~",2) Q:DFNAM="" 136 ...I $P(DFNAM,".")="ICD9" S DFNAM=$P(DFNAM," ") 137 ...S DCNT=DCNT+1,DFIAD(DCNT)=DFNAM 138 ; 139 I DTYP["result" D 140 .S DSUB=$G(DARRAY(.01)) Q:'DSUB 141 .S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT="" 142 .S DTXT=$P(DTEXT,"~",2) 143 .S RESGRP(DNAM)=DSTRT_U_DEND_U_IND_U_JND 144 ; 145 I DTYP="prompt" D 146 .;search for prompt caption 147 .S DSUB=$G(DARRAY(24)) Q:'DSUB 148 .S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT="" 149 .S DTXT=$P(DTEXT,"~",2) 150 ; 151 I DTYP="group" D 152 .;search for group caption 153 .S DSUB=$G(DARRAY(5)) Q:'DSUB 154 .S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT="" 155 .S DTXT=$P(DTEXT,"~",2) 156 .Q 157 ; 158 ;Save dialog type 159 S ^TMP("PXRMEXTMP",$J,"DTYP",DNAM)=DTYP 160 ;Save dialog component text (first line only) 161 S ^TMP("PXRMEXTMP",$J,"DTXT",DNAM)=DTXT 162 ; 163 ;Save main finding 164 I DFIND]"" S ^TMP("PXRMEXTMP",$J,"DFND",DNAM,1)=$P(DFIND,".",2,99) 165 ;Save additional findings 166 S DSUB=0 167 F S DSUB=$O(DFIAD(DSUB)) Q:'DSUB D 168 .S ^TMP("PXRMEXTMP",$J,"DFND",DNAM,DSUB+1)=$P(DFIAD(DSUB),".",2,99) 169 ; 170 ;Save additional WP text lines 171 S DSUB=0 172 F S DSUB=$O(DTXT(DSUB)) Q:'DSUB D 173 .S ^TMP("PXRMEXTMP",$J,"DTXT",DNAM,DSUB)=DTXT(DSUB) 174 ; 175 ;Save dialog's position in exchange file 176 S ^TMP("PXRMEXTMP",$J,"DLOC",DNAM)=DSTRT_U_DEND_U_IND_U_JND 177 Q 178 ; 179 ;Extract any TIU templates 180 ;------------------------- 181 DTIU(DNAM,TEXT) ; 182 N IC,TCNT,TLIST,TNAM 183 ;Templates are in format {FLD:fldname} 184 S TCNT=0 D TIUXTR^PXRMEXDG("{FLD:","}",TEXT,.TLIST,.TCNT) Q:'TCNT 185 ; 186 F IC=1:1:TCNT D 187 .S TNAM=$G(TLIST(TCNT)) Q:TNAM="" 188 .S ^TMP("PXRMEXTMP",$J,"DTIU",DNAM,TNAM)="" 189 Q 190 ; 191 ;Process WP fields 192 ;----------------- 193 DWP(TEXT) ; 194 N DIWF,DIWL,DIWR,IC,X 195 S DIWF="C50",DIWL=0,DIWR=50 196 ; 197 K ^UTILITY($J,"W") 198 S IC="" 199 F S IC=$O(TEXT(IC)) Q:IC="" D 200 .S X=TEXT(IC) 201 .D ^DIWP 202 ; 203 K TEXT 204 S IC=0 205 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 206 .S DTEXT=$G(^UTILITY($J,"W",0,IC,0)) 207 .I IC=1 S TEXT=DTEXT Q 208 .S TEXT(IC-1)=DTEXT 209 ; 210 K ^UTILITY($J,"W") 211 Q 1 PXRMEXLB ;SLC/PJH - Reminder Dialog Exchange. ;07/01/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ; 4 ;===================================================================== 5 ; 6 ;Build list of dialog components - called once from PXRMEXLC 7 ;------------------------------- 8 DBUILD(IND,NITEMS,FILENUM) ; 9 N DARRAY,DDATA,DDLG,DEND,DLOC,DMAP,DNAM,DNODE,DSEQ,DSTRT,DSUB,JND 10 ; 11 K ^TMP("PXRMEXTMP",$J),^TMP("PXRMEXFND",$J) 12 ; 13 ;Scan dialog components in 120 and save name and type 14 S JND=0 15 F S JND=$O(^PXD(811.8,IEN,120,IND,1,JND)) Q:'JND D 16 .S DDATA=$G(^PXD(811.8,IEN,120,IND,1,JND,0)) Q:DDATA="" 17 .S DNAM=$P(DDATA,U),DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3) 18 .;Extract dialog type and text and findings from exchange file 19 .D DPARSE 20 ;Scan dialog components in 120 and save dialog links 21 S JND="B" 22 F S JND=$O(^PXD(811.8,IEN,120,IND,1,JND),-1) Q:'JND D 23 .S DDATA=$G(^PXD(811.8,IEN,120,IND,1,JND,0)) Q:DDATA="" 24 .S DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3) 25 .S DDLG=$P(DDATA,U),DSUB=DSTRT+2 26 .I JND=NITEMS D 27 ..S ^TMP("PXRMEXTMP",$J,"PXRMDNAM")=DDLG 28 ..I $P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3)'["100~NATIONAL" Q 29 ..S ^TMP("PXRMEXTMP",$J,"PXRMDNAT")="" 30 .F S DSUB=$O(^PXD(811.8,IEN,100,DSUB)) Q:DSUB>DEND D 31 ..S DNODE=$G(^PXD(811.8,IEN,100,DSUB,0)) 32 ..I $P(DNODE,";")'="801.412"&($P(DNODE,";",3)'["118~") Q 33 ..S DNODE=$P(DNODE,";",3) 34 ..;;Modified Exchange to handle dialogs with replacement dialogs 35 ..I $E(DNODE,1,4)="118~" D 36 ...S DNAM=$P(DNODE,"~",2) Q:DNAM="" 37 ...S DLOC=$G(^TMP("PXRMEXTMP",$J,"DLOC",DNAM)) 38 ...S ^TMP("PXRMEXTMP",$J,"DREPL",DDLG)=DNAM_U_DLOC 39 ..I $E(DNODE,1,4)'=".01~" Q 40 ..S DSEQ=$P(DNODE,"~",2) Q:DSEQ="" 41 ..S DNODE=$G(^PXD(811.8,IEN,100,DSUB+1,0)) I $P(DNODE,";")'="801.412" Q 42 ..S DNODE=$P(DNODE,";",3) I $E(DNODE,1,2)'="2~" Q 43 ..S DNAM=$P(DNODE,"~",2) Q:DNAM="" 44 ..S DLOC=$G(^TMP("PXRMEXTMP",$J,"DLOC",DNAM)) 45 ..S ^TMP("PXRMEXTMP",$J,"DMAP",DDLG,DSEQ)=DNAM_U_DLOC 46 ; 47 ;Build index of dialog findings by name 48 ; 49 ; 50 N FDATA,FILENAM,FILENUM,FNAME 51 S IND=0 52 F S IND=$O(^PXD(811.8,IEN,120,IND)) Q:'IND D 53 .S FDATA=$G(^PXD(811.8,IEN,120,IND,0)) Q:FDATA="" 54 .S FILENAM=$P(FDATA,U),FILENUM=$P(FDATA,U,2) Q:FILENAM="" Q:'FILENUM 55 .;Ignore reminder dialogs 56 .I FILENAM="REMINDER DIALOG" Q 57 .;Ignore reminder terms 58 .I FILENAM="REMINDER TERM" Q 59 .;Strip off trailing S in finding file name 60 .I $E(FILENAM,$L(FILENAM))="S" S $E(FILENAM,$L(FILENAM))="" 61 .S JND=0 62 .F S JND=$O(^PXD(811.8,IEN,120,IND,1,JND)) Q:'JND D 63 ..S FNAME=$P($G(^PXD(811.8,IEN,120,IND,1,JND,0)),U) Q:FNAME="" 64 ..;Save entry 65 ..S ^TMP("PXRMEXFND",$J,FNAME)=FILENUM_U_FILENAM_U_IND 66 Q 67 ; 68 ;Scan exchange file to get dialog fields 69 ;--------------------------------------- 70 DPARSE N DCNT,DFIND,DFIAD,DFNAM,DFQUIT,DLCT,DLINES,DSUB,DTEXT,DTXT,DTYP 71 ; 72 ;Find where all the field numbers are kept 73 N DARRAY,DDATA,DFNUM,DRAW,DSTRING 74 S DSUB=DSTRT,DSTRING=";4;5;15;24;25;" 75 F S DSUB=$O(^PXD(811.8,IEN,100,DSUB)) Q:'DSUB D Q:DSUB>DEND 76 .S DDATA=$G(^PXD(811.8,IEN,100,DSUB,0)) Q:DDATA="" 77 .I $P(DDATA,";")'=801.41 Q 78 .S DFNUM=$P(DDATA,";",3),DFNUM=$P(DFNUM,"~") Q:DFNUM="" 79 .I DSTRING[(";"_DFNUM_";") S DARRAY(DFNUM)=DSUB 80 ; 81 ;Determine dialog component type 82 S DSUB=DARRAY(4) Q:'DSUB 83 S DTYP=$P($G(^PXD(811.8,IEN,100,DSUB,0)),"~",2) 84 S:DTYP[" " DTYP=$P(DTYP," ",2) S:DTYP="value" DTYP="forced" 85 ; 86 ;Initialise text and finding fields 87 S DTXT="*NONE*",DFIND="" 88 ;Get text appropriate for the type of component 89 I (DTYP="element")!(DTYP="group") D 90 .;search for WP text 91 .S DSUB=$G(DARRAY(25)) D:DSUB 92 ..S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT="" 93 ..;Get the line count 94 ..S DLINES=$P(DTEXT,"~",3),DCNT=0 95 ..;Get the wp text lines 96 ..F DLCT=DSUB+1:1:DSUB+DLINES D 97 ...S DTEXT=$G(^PXD(811.8,IEN,100,DLCT,0)) 98 ...S DCNT=DCNT+1,DTXT(DCNT)=DTEXT 99 ...;Check for embedded TIU templates 100 ...D DTIU(DNAM,DTEXT) 101 ..;Reformat text to 50 characters 102 ..D DWP(.DTXT) 103 .; 104 .;Search for finding item 105 .S DSUB=$G(DARRAY(15)) D:DSUB 106 ..S DFIND=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DFIND="" 107 ..;Finding name 108 ..S DFIND=$P(DFIND,"~",2) Q:DFIND="" 109 ..I $P(DFIND,".")="ICD9" S DFIND=$P(DFIND," ") 110 .; 111 .;Search for additional finding - start after WP text 112 .S DSUB=+$G(DARRAY(25)) D:DSUB 113 ..S DCNT=0,DFQUIT=0 114 ..F DLCT=DSUB+1+DLINES:1 D Q:DFQUIT Q:DLCT>DEND 115 ...S DTEXT=$G(^PXD(811.8,IEN,100,DLCT,0)) 116 ...;Ignore line if this is not an additional finding 117 ...I $P(DTEXT,";")'=801.4118 S:$P(DTEXT,";")>801.4118 DFQUIT=1 Q 118 ...S DFNAM=$P(DTEXT,"~",2) Q:DFNAM="" 119 ...I $P(DFNAM,".")="ICD9" S DFNAM=$P(DFNAM," ") 120 ...S DCNT=DCNT+1,DFIAD(DCNT)=DFNAM 121 ; 122 I DTYP="prompt" D 123 .;search for prompt caption 124 .S DSUB=$G(DARRAY(24)) Q:'DSUB 125 .S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT="" 126 .S DTXT=$P(DTEXT,"~",2) 127 ; 128 I DTYP="group" D 129 .;search for group caption 130 .S DSUB=$G(DARRAY(5)) Q:'DSUB 131 .S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT="" 132 .S DTXT=$P(DTEXT,"~",2) 133 .Q 134 ; 135 ;Save dialog type 136 S ^TMP("PXRMEXTMP",$J,"DTYP",DNAM)=DTYP 137 ;Save dialog component text (first line only) 138 S ^TMP("PXRMEXTMP",$J,"DTXT",DNAM)=DTXT 139 ; 140 ;Save main finding 141 I DFIND]"" S ^TMP("PXRMEXTMP",$J,"DFND",DNAM,1)=$P(DFIND,".",2,99) 142 ;Save additional findings 143 S DSUB=0 144 F S DSUB=$O(DFIAD(DSUB)) Q:'DSUB D 145 .S ^TMP("PXRMEXTMP",$J,"DFND",DNAM,DSUB+1)=$P(DFIAD(DSUB),".",2,99) 146 ; 147 ;Save additional WP text lines 148 S DSUB=0 149 F S DSUB=$O(DTXT(DSUB)) Q:'DSUB D 150 .S ^TMP("PXRMEXTMP",$J,"DTXT",DNAM,DSUB)=DTXT(DSUB) 151 ; 152 ;Save dialog's position in exchange file 153 S ^TMP("PXRMEXTMP",$J,"DLOC",DNAM)=DSTRT_U_DEND_U_IND_U_JND 154 Q 155 ; 156 ;Extract any TIU templates 157 ;------------------------- 158 DTIU(DNAM,TEXT) ; 159 N IC,TCNT,TLIST,TNAM 160 ;Templates are in format {FLD:fldname} 161 S TCNT=0 D TIUXTR^PXRMEXDG("{FLD:","}",TEXT,.TLIST,.TCNT) Q:'TCNT 162 ; 163 F IC=1:1:TCNT D 164 .S TNAM=$G(TLIST(TCNT)) Q:TNAM="" 165 .S ^TMP("PXRMEXTMP",$J,"DTIU",DNAM,TNAM)="" 166 Q 167 ; 168 ;Process WP fields 169 ;----------------- 170 DWP(TEXT) ; 171 N DIWF,DIWL,DIWR,IC,X 172 S DIWF="C50",DIWL=0,DIWR=50 173 ; 174 K ^UTILITY($J,"W") 175 S IC="" 176 F S IC=$O(TEXT(IC)) Q:IC="" D 177 .S X=TEXT(IC) 178 .D ^DIWP 179 ; 180 K TEXT 181 S IC=0 182 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 183 .S DTEXT=$G(^UTILITY($J,"W",0,IC,0)) 184 .I IC=1 S TEXT=DTEXT Q 185 .S TEXT(IC-1)=DTEXT 186 ; 187 K ^UTILITY($J,"W") 188 Q
Note:
See TracChangeset
for help on using the changeset viewer.
