Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXLB.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/PXRMEXLB.m
r628 r636 1 PXRMEXLB ;SLC/PJH - Reminder Dialog Exchange. ;0 5/16/20072 ;;2.0;CLINICAL REMINDERS; **6**;Feb 04, 2005;Build 1231 PXRMEXLB ;SLC/PJH - Reminder Dialog Exchange. ;07/01/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 3 ; 4 4 ;===================================================================== … … 7 7 ;------------------------------- 8 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 9 N DARRAY,DDATA,DDLG,DEND,DLOC,DMAP,DNAM,DNODE,DSEQ,DSTRT,DSUB,JND 11 10 ; 12 11 K ^TMP("PXRMEXTMP",$J),^TMP("PXRMEXFND",$J) … … 20 19 .D DPARSE 21 20 ;Scan dialog components in 120 and save dialog links 22 S JND="B" ,REPCNT=021 S JND="B" 23 22 F S JND=$O(^PXD(811.8,IEN,120,IND,1,JND),-1) Q:'JND D 24 23 .S DDATA=$G(^PXD(811.8,IEN,120,IND,1,JND,0)) Q:DDATA="" … … 31 30 .F S DSUB=$O(^PXD(811.8,IEN,100,DSUB)) Q:DSUB>DEND D 32 31 ..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,";") 32 ..I $P(DNODE,";")'="801.412"&($P(DNODE,";",3)'["118~") Q 35 33 ..S DNODE=$P(DNODE,";",3) 36 34 ..;;Modified Exchange to handle dialogs with replacement dialogs … … 38 36 ...S DNAM=$P(DNODE,"~",2) Q:DNAM="" 39 37 ...S DLOC=$G(^TMP("PXRMEXTMP",$J,"DLOC",DNAM)) 40 ...S REPCNT=REPCNT+1,^TMP("PXRMEXTMP",$J,"DREPL",REPCNT,DDLG)=DNAM_U_DLOC38 ...S ^TMP("PXRMEXTMP",$J,"DREPL",DDLG)=DNAM_U_DLOC 41 39 ..I $E(DNODE,1,4)'=".01~" Q 42 40 ..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 41 ..S DNODE=$G(^PXD(811.8,IEN,100,DSUB+1,0)) I $P(DNODE,";")'="801.412" Q 51 42 ..S DNODE=$P(DNODE,";",3) I $E(DNODE,1,2)'="2~" Q 52 43 ..S DNAM=$P(DNODE,"~",2) Q:DNAM="" … … 55 46 ; 56 47 ;Build index of dialog findings by name 48 ; 49 ; 57 50 N FDATA,FILENAM,FILENUM,FNAME 58 51 S IND=0 … … 71 64 ..;Save entry 72 65 ..S ^TMP("PXRMEXFND",$J,FNAME)=FILENUM_U_FILENAM_U_IND 73 I $D(TEMPRESL)>0 D74 .S DDLG="" F S DDLG=$O(TEMPRESL(DDLG)) Q:DDLG="" D75 ..;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 66 Q 79 67 ; … … 83 71 ; 84 72 ;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;" 73 N DARRAY,DDATA,DFNUM,DRAW,DSTRING 74 S DSUB=DSTRT,DSTRING=";4;5;15;24;25;" 88 75 F S DSUB=$O(^PXD(811.8,IEN,100,DSUB)) Q:'DSUB D Q:DSUB>DEND 89 76 .S DDATA=$G(^PXD(811.8,IEN,100,DSUB,0)) Q:DDATA="" … … 91 78 .S DFNUM=$P(DDATA,";",3),DFNUM=$P(DFNUM,"~") Q:DFNUM="" 92 79 .I DSTRING[(";"_DFNUM_";") S DARRAY(DFNUM)=DSUB 93 .I $P(DDATA,";")="801.41121" S DARRAY(55)=DSUB94 80 ; 95 81 ;Determine dialog component type 96 82 S DSUB=DARRAY(4) Q:'DSUB 97 83 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"84 S:DTYP[" " DTYP=$P(DTYP," ",2) S:DTYP="value" DTYP="forced" 99 85 ; 100 86 ;Initialise text and finding fields 101 87 S DTXT="*NONE*",DFIND="" 102 88 ;Get text appropriate for the type of component 103 I ( (DTYP="element")!(DTYP="group"))&(DTYP'["result") D89 I (DTYP="element")!(DTYP="group") D 104 90 .;search for WP text 105 91 .S DSUB=$G(DARRAY(25)) D:DSUB … … 115 101 ..;Reformat text to 50 characters 116 102 ..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 103 .; 121 104 .;Search for finding item 122 105 .S DSUB=$G(DARRAY(15)) D:DSUB … … 136 119 ...I $P(DFNAM,".")="ICD9" S DFNAM=$P(DFNAM," ") 137 120 ...S DCNT=DCNT+1,DFIAD(DCNT)=DFNAM 138 ;139 I DTYP["result" D140 .S DSUB=$G(DARRAY(.01)) Q:'DSUB141 .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_JND144 121 ; 145 122 I DTYP="prompt" D
Note:
See TracChangeset
for help on using the changeset viewer.