PXRMEXD1 ;SLC/PKR,AJP - Reminder Exchange dialog utilities. ;09/07/2007 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 ; ;====================================== BLDDISP(VIEW) ;Build ListMan array. Information about the dialog is passed ;in ^TMP("PXRMEXTMP",$J) which is built by PXRMEXLB which is ;called by CDISP^PXRMEXLC. K ^TMP("PXRMEXLD",$J) N DDATA,DDLG,DEND,DREP,DSTRT,FILENUM,IND,JND,NLINE,NSEL S (NLINE,NSEL)=0,FILENUM=801.41 S DDLG=$G(^TMP("PXRMEXTMP",$J,"PXRMDNAM")) Q:DDLG="" ;Save reminder dialog S DDATA=^TMP("PXRMEXTMP",$J,"DLOC",DDLG) S DSTRT=$P(DDATA,U,1),DEND=$P(DDATA,U,2) S IND=$P(DDATA,U,3),JND=$P(DDATA,U,4),DREP="" D DLINE(VIEW,.NLINE,DDLG,"","") S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79) S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" ;Process components D DCMP(VIEW,.NLINE,DDLG,"") ;Process replacement elements I $D(^TMP("PXRMEXTMP",$J,"DREPL"))>0 D DREPL(VIEW,.NLINE) S ^TMP("PXRMEXLD",$J,"VALMCNT")=NLINE Q ; ;====================================== CHKREPL(DLG) ; N CNT,RESULT S (CNT,RESULT)=0 F S CNT=$O(^TMP("PXRMEXTMP",$J,"DREPL",CNT)) Q:CNT'>0!(RESULT>0) D .I DLG=$O(^TMP("PXRMEXTMP",$J,"DREPL",CNT,"")) S RESULT=CNT Q Q RESULT ; ;====================================== DCMP(VIEW,NLINE,DLG,LEV) ;Save details of dialog components for display N DDATA,DEND,DNAM,DREP,DSEQ,DSTRT,IND,JND,LAST S (DSEQ,LAST)=0 F S DSEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",DLG,DSEQ)) Q:'DSEQ D .S DDATA=^TMP("PXRMEXTMP",$J,"DMAP",DLG,DSEQ) .S DNAM=$P(DDATA,U),DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3) Q:DNAM="" .S IND=$P(DDATA,U,4),JND=$P(DDATA,U,5) .;Check if this component has been replaced .S DREP=$G(PXRMNMCH(FILENUM,DNAM)) I DREP=DNAM S DREP="" .;Save line in workfile .S NUM=DSEQ .I +LEV>0,NUM>0,$E(LEV,$L(LEV))'="." S LEV=LEV_"." .D DLINE(VIEW,.NLINE,DNAM,LEV,NUM) Q:DREP'="" .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAM)) D DCMP(VIEW,.NLINE,DNAM,LEV_DSEQ_".") .;Extra line feed .I LEV="" D ..S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79) ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" I $G(REPL)["R" D .S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79) .S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" Q ; ;====================================== DLINE(VIEW,NLINE,DNAM,LEV,DSEQ) ;Update workfile ;Check if standard PXRM prompt N DPXRM S DPXRM=0 ;S DPXRM=$$PXRM^PXRMEXID(DNAM) ;Ignore PXRM prompts if doing a finding view (DF) I VIEW>1,DPXRM Q ; N DEXIST,DTXT,DTYP,EXIST,ITEM,LEVSEQ,PXRMEXRP,SEP,TEMP,X S ITEM="" I DPXRM=0 S NSEL=NSEL+1,ITEM=NSEL S NLINE=NLINE+1,SEP=$E(LEV,$L(LEV)),DEXIST=0 S LEVSEQ=LEV_DSEQ S TEMP=$J(ITEM,3)_$J("",4)_LEV_DSEQ ;Determine type S DTYP=$G(^TMP("PXRMEXTMP",$J,"DTYP",DNAM)) I DTYP["result" S DTYP=$$STRREP^PXRMUTIL(DTYP,"result","rs.") ;Dialog component display I (VIEW'=1) D .I DTYP["rs." D Q ..F X=1:1:$L(TEMP) S $E(TEMP,X)=" " ..S TEMP=TEMP_$J("",12+$L(SEP)-$L(TEMP))_$E(DNAM,1,50) .I $L(TEMP)<13 S TEMP=TEMP_$J("",12+$L(SEP)-$L(TEMP))_$E(DNAM,1,50) .E S TEMP=TEMP_" "_$E(DNAM,1,50) I VIEW=1 D .I DTYP]"" S DTXT=$G(^TMP("PXRMEXTMP",$J,"DTXT",DNAM)) .I DTYP="" S DTXT=DNAM .I DREP'="" S DTXT=DNAM .I $L(TEMP)<13 S TEMP=TEMP_$J("",12+$L(SEP)-$L(TEMP))_$E(DTXT,1,50) .E S TEMP=TEMP_" "_$E(DTXT,1,50) ;Check for replacements I $D(^TMP("PXRMEXTMP",$J,"DREPL"))>0 D .I $$CHKREPL(DNAM)>0 D ..S TEMP=TEMP_"*" ..S TLEV=$S($E(LEVSEQ,$L(LEVSEQ))=".":$E(LEVSEQ,1,$L(LEVSEQ)-1),1:LEVSEQ) ..S PXRMEXRP(DNAM)="" ;Add Type S TEMP=TEMP_$J("",65-$L(TEMP))_DTYP ;Exists flag S DEXIST=$$EXISTS^PXRMEXIU(801.41,DNAM) I DEXIST S TEMP=TEMP_$J("",77-$L(TEMP))_"X" S ^TMP("PXRMEXLD",$J,NLINE,0)=TEMP ; ;Set up selection index S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" Q:DPXRM=1 ;Store the file number, start and stop line in the exchange file. S ^TMP("PXRMEXLD",$J,"SEL",NSEL)=FILENUM_U_DSTRT_U_DEND_U_DEXIST_U_IND_U_JND_U_DNAM ;Insert additional text lines I VIEW=1,DREP="" D .N DSUB,DTXT,FILENUM .S DSUB=0,FILENUM=8927.1 .F S DSUB=$O(^TMP("PXRMEXTMP",$J,"DTXT",DNAM,DSUB)) Q:'DSUB D ..S DTXT=$G(^TMP("PXRMEXTMP",$J,"DTXT",DNAM,DSUB)),NLINE=NLINE+1 ..S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",12+$L(SEP))_$E(DTXT,1,50) ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" .;TIU template changes .I $D(PXRMNMCH(FILENUM)),$D(^TMP("PXRMEXTMP",$J,"DTIU",DNAM)) D ..N TEMP,TNAM,TNNAM ..S TNAM="" ..F S TNAM=$O(^TMP("PXRMEXTMP",$J,"DTIU",DNAM,TNAM)) Q:TNAM="" D ...S TNNAM=$G(PXRMNMCH(FILENUM,TNAM)) Q:TNNAM="" ...S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79) ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" ...S TEMP=$J("",12+$L(SEP))_"(TIU template "_TNAM_" copied to "_TNNAM_")" ...S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=TEMP ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" ...S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79) ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" ;Insert finding items I VIEW=2,("element;group"[DTYP),"rs."'[DTYP,DREP="" D .N DSUB,FDATA,FILENUM,FLIT,FLONG,FNAME,FOUND,FREP,FTAB,FTYP,TEMP .;Findings and additional findings .S DSUB=0,FOUND=0 .F S DSUB=$O(^TMP("PXRMEXTMP",$J,"DFND",DNAM,DSUB)) Q:'DSUB D ..S FNAME=$G(^TMP("PXRMEXTMP",$J,"DFND",DNAM,DSUB)) Q:FNAME="" ..S FDATA=$G(^TMP("PXRMEXFND",$J,FNAME)) ..S FILENUM=$P(FDATA,U),FTYP=$P(FDATA,U,2) Q:'FILENUM ..S FREP=$G(PXRMNMCH(FILENUM,FNAME)) I FREP=FNAME S FREP="" ..S NLINE=NLINE+1,EXIST=$$EXISTS^PXRMEXIU(FILENUM,FNAME),FOUND=1 ..I DSUB=1 S FLIT="Finding: " ..I DSUB>1 S FLIT="Add. Finding: " ..S FLONG=0 I $L(FLIT_FNAME_" ("_FTYP_")")>60 S FLONG=1 ..I 'FLONG S FNAME=FLIT_FNAME_" ("_FTYP_")" ..I FLONG S FNAME=FLIT_FNAME ..S TEMP=$J("",12+$L(SEP))_$E(FNAME,1,60)_$J("",60-$L(FNAME)) ..I EXIST S TEMP=TEMP_$J("",77-$L(TEMP))_"X" ..S ^TMP("PXRMEXLD",$J,NLINE,0)=TEMP ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" ..I FLONG D ...S NLINE=NLINE+1 ...S FTAB=$S(DSUB=1:21,1:26) ...S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",FTAB)_"("_FTYP_")" ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" ..I FREP'="" D ...S NLINE=NLINE+1 ...S FTAB=$S(DSUB=1:21,1:26) ...S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",FTAB)_"(Replaced by "_FREP_")" ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" .;If no findings .I 'FOUND D ..S NLINE=NLINE+1 ..S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",12+$L(SEP))_"Finding: *NONE*" ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" ; ;Usage screen I VIEW=4,DREP="" D .N DOTHER,DTXT,DTYPE,OTHER,TYPE .D OTHER(DNAM,.DOTHER) Q:'$D(DOTHER) .S OTHER="" .F S OTHER=$O(DOTHER(OTHER)) Q:OTHER="" D ..S TYPE=DOTHER(OTHER),NLINE=NLINE+1,DTYPE="REMINDER DIALOG" ..I TYPE="G" S DTYPE="DIALOG GROUP" ..I TYPE="E" S DTYPE="DIALOG ELEMENT" ..S DTXT="USED BY: "_OTHER_" ("_DTYPE_")" ..S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",12+$L(SEP))_DTXT ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" Q ; ;====================================== DREPL(VIEW,NLINE) ;Build replacement elements/groups for List Man display. N CNT,DLG,DDATA,DDLG,DEND,DNAM,DREP,DSTRT,IND,JND,LEV,PXRMEXOR,STR,TEMP S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79) S STR="" F IND=1:1:30 S STR=STR_"-" S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J(STR_" REPLACEMENT ITEMS "_STR,79) S (CNT,LEV)=0 F S CNT=$O(^TMP("PXRMEXTMP",$J,"DREPL",CNT)) Q:CNT'>0 D .S DLG=$O(^TMP("PXRMEXTMP",$J,"DREPL",CNT,"")) Q:DLG="" .S DDATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",CNT,DLG)) Q:DDATA="" .S DNAM=$P(DDATA,U),DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3) Q:DNAM="" .I $D(PXRMEXOR(DNAM))>0 Q .S PXRMEXOR(DNAM)="" .S IND=$P(DDATA,U,4),JND=$P(DDATA,U,5) .;Check if this component has been replaced .S LEV=LEV+1 .S DREP=$G(PXRMNMCH(FILENUM,DNAM)) I DREP=DNAM S DREP="" .;Save line in workfile .S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79) .S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" .D DLINE(VIEW,.NLINE,DNAM,LEV,"") .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAM)) D DCMP(VIEW,.NLINE,DNAM,LEV) Q ; ;====================================== OTHER(NAME,LIST) ;Check if used by other dialogs N DDATA,DIEN,DNAME,DTYP,IEN S IEN=$O(^PXRMD(801.41,"B",NAME,0)) Q:'IEN ;Check if used by other dialogs I '$D(^PXRMD(801.41,"AD",IEN)) Q ;Build list of dialogs using this component S DIEN=0 F S DIEN=$O(^PXRMD(801.41,"AD",IEN,DIEN)) Q:'DIEN D .S DDATA=$G(^PXRMD(801.41,DIEN,0)) Q:DDATA="" .S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4) Q:DNAME="" .;Include only dialogs that are not part of this reminder dialog .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) Q .S LIST(DNAME)=DTYP Q ;