- PXRMEXDB ;SLC/PKR,AGP - Build List Manager dialog display. ;08/16/2018
- ;;2.0;CLINICAL REMINDERS;**6,12,42**;Feb 04, 2005;Build 245
- ;
- ;======================================
- 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.
- N DNAME,NLINE,NSEL
- S DNAME=$G(^TMP("PXRMEXTMP",$J,"PXRMDNAME")) Q:DNAME=""
- K ^TMP("PXRMEXLD",$J)
- S (NLINE,NSEL)=0
- ;Save reminder dialog
- D DLINE(DNAME,VIEW,.NLINE,DNAME,"","","")
- S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=""
- S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
- ;Process components
- D DCMP(DNAME,VIEW,.NLINE,DNAME,"",0)
- ;Process replacement elements
- I $D(^TMP("PXRMEXTMP",$J,"DREPL",DNAME))>0 D DREPL(DNAME,VIEW,.NLINE)
- S ^TMP("PXRMEXLD",$J,"VALMCNT")=NLINE
- Q
- ;
- ;======================================
- CHKREPL(DIALNAM,DLG) ;
- N CNT,RESULT
- S (CNT,RESULT)=0
- F S CNT=$O(^TMP("PXRMEXTMP",$J,"DREPL",DIALNAM,CNT)) Q:CNT'>0!(RESULT>0) D
- .I DLG=$O(^TMP("PXRMEXTMP",$J,"DREPL",DIALNAM,CNT,"")) S RESULT=CNT Q
- Q RESULT
- ;
- ;======================================
- DCMP(DIALNAM,VIEW,NLINE,DLG,LEV,INREPL) ;Save details of dialog components for display
- N DNAME,DREP,DSEQ,LAST,NUM
- S (DSEQ,LAST)=0
- I INREPL,$D(^TMP("PXRMEXTMP",$J,"DREPL ITEMS",DLG)) D
- .S DNAME="" F S DNAME=$O(^TMP("PXRMEXTMP",$J,"DREPL ITEMS",DLG,DNAME)) Q:DNAME="" D
- ..S DREP=$G(PXRMNMCH(FILENUM,DNAME)) I DREP=DNAME S DREP=""
- ..D DLINE(DIALNAM,VIEW,.NLINE,DNAME,LEV,"",DREP)
- ..D DCMP(DIALNAM,VIEW,.NLINE,DNAME,LEV,INREPL)
- F S DSEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",DLG,DSEQ)) Q:'DSEQ D
- .S DNAME=$P(^TMP("PXRMEXTMP",$J,"DMAP",DLG,DSEQ),U,1) Q:DNAME=""
- .;Check if this component has been replaced
- .S DREP=$G(PXRMNMCH(FILENUM,DNAME)) I DREP=DNAME S DREP=""
- .;Save line in workfile
- .S NUM=DSEQ
- .I +LEV>0,NUM>0,$E(LEV,$L(LEV))'="." S LEV=LEV_"."
- .D DLINE(DIALNAM,VIEW,.NLINE,DNAME,LEV,NUM,DREP) Q:DREP'=""
- .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D DCMP(DIALNAM,VIEW,.NLINE,DNAME,LEV_DSEQ_".",INREPL)
- .;Extra line feed
- .I LEV="" D
- ..S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=""
- ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
- Q
- ;
- ;======================================
- DLINE(DIALNAM,VIEW,NLINE,DNAME,LEV,DSEQ,DREP) ;Update workfile
- N DEXIST,DTXT,DTYP,EXIST,FMTSTR,IND,ITEM,LEVSEQ,LINE,NOUT
- N SEP,TEMP,TEXTOUT,X
- S NSEL=NSEL+1,ITEM=NSEL,NLINE=NLINE+1
- S LEVSEQ=LEV_DSEQ,SEP=$E(LEV,$L(LEV))
- ;Determine type
- S DTYP=$G(^TMP("PXRMEXTMP",$J,"DTYP",DNAME))
- I $D(^TMP("PXRMEXDGH",$J,ITEM)) G EXF
- S TEMP=ITEM
- I (DTYP'["rs")&(DTYP'["prompt")&(DTYP'["forced") S TEMP=TEMP_"^"_LEVSEQ_" "_DNAME
- E S TEMP=TEMP_"^"_DNAME
- ;Check for replacements
- I $D(^TMP("PXRMEXTMP",$J,"DREPL",DIALNAM)),$$CHKREPL(DIALNAM,DNAME) S TEMP=TEMP_"*"
- ;Add Type
- S TEMP=TEMP_"^"_DTYP
- ;Dialog component display
- S FMTSTR="4R3^52L1^10R1"
- D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NOUT,.TEXTOUT)
- S ^TMP("PXRMEXDGH",$J,ITEM)=NOUT
- F IND=1:1:NOUT S ^TMP("PXRMEXDGH",$J,ITEM,IND)=TEXTOUT(IND)
- ;
- ;Exists flag
- EXF S DEXIST=$$EXISTS^PXRMEXIU(801.41,DNAME)
- S LINE=^TMP("PXRMEXDGH",$J,ITEM,1)
- I DEXIST S LINE=LINE_$J("",76-$L(LINE))_"X"
- S ^TMP("PXRMEXLD",$J,NLINE,0)=LINE
- ;
- ;Set up selection index
- S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
- S TEMP=^TMP("PXRMEXTMP",$J,"DLOC",DNAME)
- ;Store the file number, 100 node start and stop line, 120 node indexes.
- S ^TMP("PXRMEXLD",$J,"SEL",NSEL)=801.41_U_TEMP_U_DEXIST_U_DNAME
- ;
- ;Display any additional lines.
- S NOUT=^TMP("PXRMEXDGH",$J,ITEM)
- I NOUT>1 F IND=2:1:NOUT S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=^TMP("PXRMEXDGH",$J,ITEM,IND)
- ;
- ;Insert additional text lines
- I VIEW=1,DREP="" D VIEW1(DNAME,.NLINE,NSEL,SEP)
- ;
- ;Insert finding items
- I VIEW=2,("element;group"[DTYP),"rs."'[DTYP,DREP="" D VIEW2(DNAME,.NLINE,NSEL)
- ;
- ;Usage screen
- I VIEW=4,DREP="" D VIEW4(.NLINE,NSEL,SEP)
- Q
- ;
- ;======================================
- DREPL(DIALNAM,VIEW,NLINE) ;Build replacement elements/groups for List Man display.
- N CNT,DLG,DNAME,DREP,LEV,PXRMEXOR,STR,TEMP
- S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=""
- S $P(STR,"-",31)=""
- S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J(STR_" REPLACEMENT ITEMS "_STR,79)
- S (CNT,LEV)=0,CNT=""
- F S CNT=$O(^TMP("PXRMEXTMP",$J,"DREPL",DIALNAM,CNT),-1) Q:CNT'>0 D
- .S DLG=$O(^TMP("PXRMEXTMP",$J,"DREPL",DIALNAM,CNT,"")) Q:DLG=""
- .S DNAME=$P($G(^TMP("PXRMEXTMP",$J,"DREPL",DIALNAM,CNT,DLG)),U,1) Q:DNAME=""
- .I $D(PXRMEXOR(DNAME)) Q
- .S PXRMEXOR(DNAME)=""
- .;Check if this component has been replaced
- .S LEV=LEV+1
- .S DREP=$G(PXRMNMCH(FILENUM,DNAME)) I DREP=DNAME S DREP=""
- .;Save line in workfile
- .S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=""
- .S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
- .D DLINE(DIALNAM,VIEW,.NLINE,DNAME,LEV,"",DREP)
- .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D DCMP(DIALNAM,VIEW,.NLINE,DNAME,LEV,1)
- 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
- ;
- ;======================================
- VIEW1(DNAME,NLINE,NSEL,SEP) ;Build the text view.
- N DSUB,DTXT,FILENUM
- S DTXT=$G(^TMP("PXRMEXTMP",$J,"DTXT",DNAME))
- I (DTXT'=""),(DTXT'=DNAME) D
- . S NLINE=NLINE+1
- . S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",12+$L(SEP))_$E(DTXT,1,50)
- . S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
- S DSUB=0,FILENUM=8927.1
- F S DSUB=$O(^TMP("PXRMEXTMP",$J,"DTXT",DNAME,DSUB)) Q:'DSUB D
- .S DTXT=$G(^TMP("PXRMEXTMP",$J,"DTXT",DNAME,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",DNAME)) D
- .N LINE,TNAM,TNNAM
- .S TNAM=""
- .F S TNAM=$O(^TMP("PXRMEXTMP",$J,"DTIU",DNAME,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 LINE=$J("",12+$L(SEP))_"(TIU template "_TNAM_" copied to "_TNNAM_")"
- ..S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=LINE
- ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
- ..S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=""
- ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
- Q
- ;
- ;======================================
- VIEW2(DNAME,NLINE,NSEL) ;Build the finding view.
- N DSUB,EXISTS,FDATA,FILENUM,FLIT,FLONG,FMTSTR,FNAME,FOUND
- N FTAB,FTYP,IND,LINE,NL,OUTPUT,TEMP
- S FMTSTR="12R^60L4^1C"
- ;Findings and additional findings
- S DSUB=0,FOUND=0
- F S DSUB=$O(^TMP("PXRMEXTMP",$J,"DFND",DNAME,DSUB)) Q:'DSUB D
- .S FNAME=$G(^TMP("PXRMEXTMP",$J,"DFND",DNAME,DSUB)) Q:FNAME=""
- .S FDATA=$G(^TMP("PXRMEXFND",$J,FNAME))
- .S FILENUM=$P(FDATA,U),FTYP=$P(FDATA,U,2) Q:'FILENUM
- .;S EXIST=$$EXISTS^PXRMEXIU(FILENUM,FNAME),FOUND=1
- .S EXIST=$$EXISTS^PXRMEXIU(FILENUM,FNAME,"W"),FOUND=1
- .I FOUND D
- ..S TEMP=U_$S(DSUB>1:"Add. Finding: ",1:"Finding: ")
- ..S TEMP=TEMP_FNAME_" ("_FTYP_")"
- ..I EXIST S TEMP=TEMP_U_"X"
- .D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
- .F IND=1:1:NL D
- .. S NLINE=NLINE+1
- .. S ^TMP("PXRMEXLD",$J,NLINE,0)=OUTPUT(IND)
- .. 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)_"Finding: *NONE*"
- .S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
- Q
- ;
- ;======================================
- VIEW4(DNAME,NLINE,NSEL,SEP) ;Build the usage view.
- N DOTHER,DTXT,DTYPE,OTHER,TYPE
- D OTHER(DNAME,.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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXDB 8366 printed Feb 18, 2025@23:11:15 Page 2
- PXRMEXDB ;SLC/PKR,AGP - Build List Manager dialog display. ;08/16/2018
- +1 ;;2.0;CLINICAL REMINDERS;**6,12,42**;Feb 04, 2005;Build 245
- +2 ;
- +3 ;======================================
- BLDDISP(VIEW) ;Build ListMan array. Information about the dialog is passed
- +1 ;in ^TMP("PXRMEXTMP",$J) which is built by PXRMEXLB which is
- +2 ;called by CDISP^PXRMEXLC.
- +3 NEW DNAME,NLINE,NSEL
- +4 SET DNAME=$GET(^TMP("PXRMEXTMP",$JOB,"PXRMDNAME"))
- if DNAME=""
- QUIT
- +5 KILL ^TMP("PXRMEXLD",$JOB)
- +6 SET (NLINE,NSEL)=0
- +7 ;Save reminder dialog
- +8 DO DLINE(DNAME,VIEW,.NLINE,DNAME,"","","")
- +9 SET NLINE=NLINE+1
- SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=""
- +10 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- +11 ;Process components
- +12 DO DCMP(DNAME,VIEW,.NLINE,DNAME,"",0)
- +13 ;Process replacement elements
- +14 IF $DATA(^TMP("PXRMEXTMP",$JOB,"DREPL",DNAME))>0
- DO DREPL(DNAME,VIEW,.NLINE)
- +15 SET ^TMP("PXRMEXLD",$JOB,"VALMCNT")=NLINE
- +16 QUIT
- +17 ;
- +18 ;======================================
- CHKREPL(DIALNAM,DLG) ;
- +1 NEW CNT,RESULT
- +2 SET (CNT,RESULT)=0
- +3 FOR
- SET CNT=$ORDER(^TMP("PXRMEXTMP",$JOB,"DREPL",DIALNAM,CNT))
- if CNT'>0!(RESULT>0)
- QUIT
- Begin DoDot:1
- +4 IF DLG=$ORDER(^TMP("PXRMEXTMP",$JOB,"DREPL",DIALNAM,CNT,""))
- SET RESULT=CNT
- QUIT
- End DoDot:1
- +5 QUIT RESULT
- +6 ;
- +7 ;======================================
- DCMP(DIALNAM,VIEW,NLINE,DLG,LEV,INREPL) ;Save details of dialog components for display
- +1 NEW DNAME,DREP,DSEQ,LAST,NUM
- +2 SET (DSEQ,LAST)=0
- +3 IF INREPL
- IF $DATA(^TMP("PXRMEXTMP",$JOB,"DREPL ITEMS",DLG))
- Begin DoDot:1
- +4 SET DNAME=""
- FOR
- SET DNAME=$ORDER(^TMP("PXRMEXTMP",$JOB,"DREPL ITEMS",DLG,DNAME))
- if DNAME=""
- QUIT
- Begin DoDot:2
- +5 SET DREP=$GET(PXRMNMCH(FILENUM,DNAME))
- IF DREP=DNAME
- SET DREP=""
- +6 DO DLINE(DIALNAM,VIEW,.NLINE,DNAME,LEV,"",DREP)
- +7 DO DCMP(DIALNAM,VIEW,.NLINE,DNAME,LEV,INREPL)
- End DoDot:2
- End DoDot:1
- +8 FOR
- SET DSEQ=$ORDER(^TMP("PXRMEXTMP",$JOB,"DMAP",DLG,DSEQ))
- if 'DSEQ
- QUIT
- Begin DoDot:1
- +9 SET DNAME=$PIECE(^TMP("PXRMEXTMP",$JOB,"DMAP",DLG,DSEQ),U,1)
- if DNAME=""
- QUIT
- +10 ;Check if this component has been replaced
- +11 SET DREP=$GET(PXRMNMCH(FILENUM,DNAME))
- IF DREP=DNAME
- SET DREP=""
- +12 ;Save line in workfile
- +13 SET NUM=DSEQ
- +14 IF +LEV>0
- IF NUM>0
- IF $EXTRACT(LEV,$LENGTH(LEV))'="."
- SET LEV=LEV_"."
- +15 DO DLINE(DIALNAM,VIEW,.NLINE,DNAME,LEV,NUM,DREP)
- if DREP'=""
- QUIT
- +16 IF $DATA(^TMP("PXRMEXTMP",$JOB,"DMAP",DNAME))
- DO DCMP(DIALNAM,VIEW,.NLINE,DNAME,LEV_DSEQ_".",INREPL)
- +17 ;Extra line feed
- +18 IF LEV=""
- Begin DoDot:2
- +19 SET NLINE=NLINE+1
- SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=""
- +20 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- End DoDot:2
- End DoDot:1
- +21 QUIT
- +22 ;
- +23 ;======================================
- DLINE(DIALNAM,VIEW,NLINE,DNAME,LEV,DSEQ,DREP) ;Update workfile
- +1 NEW DEXIST,DTXT,DTYP,EXIST,FMTSTR,IND,ITEM,LEVSEQ,LINE,NOUT
- +2 NEW SEP,TEMP,TEXTOUT,X
- +3 SET NSEL=NSEL+1
- SET ITEM=NSEL
- SET NLINE=NLINE+1
- +4 SET LEVSEQ=LEV_DSEQ
- SET SEP=$EXTRACT(LEV,$LENGTH(LEV))
- +5 ;Determine type
- +6 SET DTYP=$GET(^TMP("PXRMEXTMP",$JOB,"DTYP",DNAME))
- +7 IF $DATA(^TMP("PXRMEXDGH",$JOB,ITEM))
- GOTO EXF
- +8 SET TEMP=ITEM
- +9 IF (DTYP'["rs")&(DTYP'["prompt")&(DTYP'["forced")
- SET TEMP=TEMP_"^"_LEVSEQ_" "_DNAME
- +10 IF '$TEST
- SET TEMP=TEMP_"^"_DNAME
- +11 ;Check for replacements
- +12 IF $DATA(^TMP("PXRMEXTMP",$JOB,"DREPL",DIALNAM))
- IF $$CHKREPL(DIALNAM,DNAME)
- SET TEMP=TEMP_"*"
- +13 ;Add Type
- +14 SET TEMP=TEMP_"^"_DTYP
- +15 ;Dialog component display
- +16 SET FMTSTR="4R3^52L1^10R1"
- +17 DO COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NOUT,.TEXTOUT)
- +18 SET ^TMP("PXRMEXDGH",$JOB,ITEM)=NOUT
- +19 FOR IND=1:1:NOUT
- SET ^TMP("PXRMEXDGH",$JOB,ITEM,IND)=TEXTOUT(IND)
- +20 ;
- +21 ;Exists flag
- EXF SET DEXIST=$$EXISTS^PXRMEXIU(801.41,DNAME)
- +1 SET LINE=^TMP("PXRMEXDGH",$JOB,ITEM,1)
- +2 IF DEXIST
- SET LINE=LINE_$JUSTIFY("",76-$LENGTH(LINE))_"X"
- +3 SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=LINE
- +4 ;
- +5 ;Set up selection index
- +6 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- +7 SET TEMP=^TMP("PXRMEXTMP",$JOB,"DLOC",DNAME)
- +8 ;Store the file number, 100 node start and stop line, 120 node indexes.
- +9 SET ^TMP("PXRMEXLD",$JOB,"SEL",NSEL)=801.41_U_TEMP_U_DEXIST_U_DNAME
- +10 ;
- +11 ;Display any additional lines.
- +12 SET NOUT=^TMP("PXRMEXDGH",$JOB,ITEM)
- +13 IF NOUT>1
- FOR IND=2:1:NOUT
- SET NLINE=NLINE+1
- SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=^TMP("PXRMEXDGH",$JOB,ITEM,IND)
- +14 ;
- +15 ;Insert additional text lines
- +16 IF VIEW=1
- IF DREP=""
- DO VIEW1(DNAME,.NLINE,NSEL,SEP)
- +17 ;
- +18 ;Insert finding items
- +19 IF VIEW=2
- IF ("element;group"[DTYP)
- IF "rs."'[DTYP
- IF DREP=""
- DO VIEW2(DNAME,.NLINE,NSEL)
- +20 ;
- +21 ;Usage screen
- +22 IF VIEW=4
- IF DREP=""
- DO VIEW4(.NLINE,NSEL,SEP)
- +23 QUIT
- +24 ;
- +25 ;======================================
- DREPL(DIALNAM,VIEW,NLINE) ;Build replacement elements/groups for List Man display.
- +1 NEW CNT,DLG,DNAME,DREP,LEV,PXRMEXOR,STR,TEMP
- +2 SET NLINE=NLINE+1
- SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=""
- +3 SET $PIECE(STR,"-",31)=""
- +4 SET NLINE=NLINE+1
- SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=$JUSTIFY(STR_" REPLACEMENT ITEMS "_STR,79)
- +5 SET (CNT,LEV)=0
- SET CNT=""
- +6 FOR
- SET CNT=$ORDER(^TMP("PXRMEXTMP",$JOB,"DREPL",DIALNAM,CNT),-1)
- if CNT'>0
- QUIT
- Begin DoDot:1
- +7 SET DLG=$ORDER(^TMP("PXRMEXTMP",$JOB,"DREPL",DIALNAM,CNT,""))
- if DLG=""
- QUIT
- +8 SET DNAME=$PIECE($GET(^TMP("PXRMEXTMP",$JOB,"DREPL",DIALNAM,CNT,DLG)),U,1)
- if DNAME=""
- QUIT
- +9 IF $DATA(PXRMEXOR(DNAME))
- QUIT
- +10 SET PXRMEXOR(DNAME)=""
- +11 ;Check if this component has been replaced
- +12 SET LEV=LEV+1
- +13 SET DREP=$GET(PXRMNMCH(FILENUM,DNAME))
- IF DREP=DNAME
- SET DREP=""
- +14 ;Save line in workfile
- +15 SET NLINE=NLINE+1
- SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=""
- +16 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- +17 DO DLINE(DIALNAM,VIEW,.NLINE,DNAME,LEV,"",DREP)
- +18 IF $DATA(^TMP("PXRMEXTMP",$JOB,"DMAP",DNAME))
- DO DCMP(DIALNAM,VIEW,.NLINE,DNAME,LEV,1)
- End DoDot:1
- +19 QUIT
- +20 ;
- +21 ;======================================
- OTHER(NAME,LIST) ;Check if used by other dialogs
- +1 NEW DDATA,DIEN,DNAME,DTYP,IEN
- +2 SET IEN=$ORDER(^PXRMD(801.41,"B",NAME,0))
- if 'IEN
- QUIT
- +3 ;Check if used by other dialogs
- +4 IF '$DATA(^PXRMD(801.41,"AD",IEN))
- QUIT
- +5 ;Build list of dialogs using this component
- +6 SET DIEN=0
- +7 FOR
- SET DIEN=$ORDER(^PXRMD(801.41,"AD",IEN,DIEN))
- if 'DIEN
- QUIT
- Begin DoDot:1
- +8 SET DDATA=$GET(^PXRMD(801.41,DIEN,0))
- if DDATA=""
- QUIT
- +9 SET DNAME=$PIECE(DDATA,U)
- SET DTYP=$PIECE(DDATA,U,4)
- if DNAME=""
- QUIT
- +10 ;Include only dialogs that are not part of this reminder dialog
- +11 IF $DATA(^TMP("PXRMEXTMP",$JOB,"DMAP",DNAME))
- QUIT
- +12 SET LIST(DNAME)=DTYP
- End DoDot:1
- +13 QUIT
- +14 ;
- +15 ;======================================
- VIEW1(DNAME,NLINE,NSEL,SEP) ;Build the text view.
- +1 NEW DSUB,DTXT,FILENUM
- +2 SET DTXT=$GET(^TMP("PXRMEXTMP",$JOB,"DTXT",DNAME))
- +3 IF (DTXT'="")
- IF (DTXT'=DNAME)
- Begin DoDot:1
- +4 SET NLINE=NLINE+1
- +5 SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=$JUSTIFY("",12+$LENGTH(SEP))_$EXTRACT(DTXT,1,50)
- +6 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- End DoDot:1
- +7 SET DSUB=0
- SET FILENUM=8927.1
- +8 FOR
- SET DSUB=$ORDER(^TMP("PXRMEXTMP",$JOB,"DTXT",DNAME,DSUB))
- if 'DSUB
- QUIT
- Begin DoDot:1
- +9 SET DTXT=$GET(^TMP("PXRMEXTMP",$JOB,"DTXT",DNAME,DSUB))
- SET NLINE=NLINE+1
- +10 SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=$JUSTIFY("",12+$LENGTH(SEP))_$EXTRACT(DTXT,1,50)
- +11 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- End DoDot:1
- +12 ;TIU template changes
- +13 IF $DATA(PXRMNMCH(FILENUM))
- IF $DATA(^TMP("PXRMEXTMP",$JOB,"DTIU",DNAME))
- Begin DoDot:1
- +14 NEW LINE,TNAM,TNNAM
- +15 SET TNAM=""
- +16 FOR
- SET TNAM=$ORDER(^TMP("PXRMEXTMP",$JOB,"DTIU",DNAME,TNAM))
- if TNAM=""
- QUIT
- Begin DoDot:2
- +17 SET TNNAM=$GET(PXRMNMCH(FILENUM,TNAM))
- if TNNAM=""
- QUIT
- +18 SET NLINE=NLINE+1
- SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=$JUSTIFY("",79)
- +19 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- +20 SET LINE=$JUSTIFY("",12+$LENGTH(SEP))_"(TIU template "_TNAM_" copied to "_TNNAM_")"
- +21 SET NLINE=NLINE+1
- SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=LINE
- +22 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- +23 SET NLINE=NLINE+1
- SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=""
- +24 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- End DoDot:2
- End DoDot:1
- +25 QUIT
- +26 ;
- +27 ;======================================
- VIEW2(DNAME,NLINE,NSEL) ;Build the finding view.
- +1 NEW DSUB,EXISTS,FDATA,FILENUM,FLIT,FLONG,FMTSTR,FNAME,FOUND
- +2 NEW FTAB,FTYP,IND,LINE,NL,OUTPUT,TEMP
- +3 SET FMTSTR="12R^60L4^1C"
- +4 ;Findings and additional findings
- +5 SET DSUB=0
- SET FOUND=0
- +6 FOR
- SET DSUB=$ORDER(^TMP("PXRMEXTMP",$JOB,"DFND",DNAME,DSUB))
- if 'DSUB
- QUIT
- Begin DoDot:1
- +7 SET FNAME=$GET(^TMP("PXRMEXTMP",$JOB,"DFND",DNAME,DSUB))
- if FNAME=""
- QUIT
- +8 SET FDATA=$GET(^TMP("PXRMEXFND",$JOB,FNAME))
- +9 SET FILENUM=$PIECE(FDATA,U)
- SET FTYP=$PIECE(FDATA,U,2)
- if 'FILENUM
- QUIT
- +10 ;S EXIST=$$EXISTS^PXRMEXIU(FILENUM,FNAME),FOUND=1
- +11 SET EXIST=$$EXISTS^PXRMEXIU(FILENUM,FNAME,"W")
- SET FOUND=1
- +12 IF FOUND
- Begin DoDot:2
- +13 SET TEMP=U_$SELECT(DSUB>1:"Add. Finding: ",1:"Finding: ")
- +14 SET TEMP=TEMP_FNAME_" ("_FTYP_")"
- +15 IF EXIST
- SET TEMP=TEMP_U_"X"
- End DoDot:2
- +16 DO COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
- +17 FOR IND=1:1:NL
- Begin DoDot:2
- +18 SET NLINE=NLINE+1
- +19 SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=OUTPUT(IND)
- +20 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- End DoDot:2
- End DoDot:1
- +21 ;If no findings
- +22 IF 'FOUND
- Begin DoDot:1
- +23 SET NLINE=NLINE+1
- +24 SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=$JUSTIFY("",12)_"Finding: *NONE*"
- +25 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- End DoDot:1
- +26 QUIT
- +27 ;
- +28 ;======================================
- VIEW4(DNAME,NLINE,NSEL,SEP) ;Build the usage view.
- +1 NEW DOTHER,DTXT,DTYPE,OTHER,TYPE
- +2 DO OTHER(DNAME,.DOTHER)
- if '$DATA(DOTHER)
- QUIT
- +3 SET OTHER=""
- +4 FOR
- SET OTHER=$ORDER(DOTHER(OTHER))
- if OTHER=""
- QUIT
- Begin DoDot:1
- +5 SET TYPE=DOTHER(OTHER)
- SET NLINE=NLINE+1
- SET DTYPE="REMINDER DIALOG"
- +6 IF TYPE="G"
- SET DTYPE="DIALOG GROUP"
- +7 IF TYPE="E"
- SET DTYPE="DIALOG ELEMENT"
- +8 SET DTXT="USED BY: "_OTHER_" ("_DTYPE_")"
- +9 SET ^TMP("PXRMEXLD",$JOB,NLINE,0)=$JUSTIFY("",12+$LENGTH(SEP))_DTXT
- +10 SET ^TMP("PXRMEXLD",$JOB,"IDX",NLINE,NSEL)=""
- End DoDot:1
- +11 QUIT
- +12 ;