PXRMDLR2 ;SLC/AGP - Dialog reporting routine to find active CPRS dialogs ;09/14/2017
;;2.0;CLINICAL REMINDERS;**53,45**;Feb 04, 2005;Build 566
Q
;
ASK(YESNO,PROMPT,NUM) ;
N X,Y,TEXT
K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="YA0"
S DIR("A")=PROMPT
S DIR("B")="N"
S DIR("?")="Enter Y or N. For detailed help type ??"
S DIR("??")=U_"D HELP^PXRMDLRH("_NUM_")"
W !
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S YESNO=$E(Y(0))
Q
;
FINDDIAL ;
N DIROUT,DIRUT,DTOUT,DUOUT
N ANS,CPRSONLY,DARRAY,DLIST,NAME,NEWP,PARAMS,FINAL,SHOWREAS,TEMPDIAL,TLIST,USER
K ^TMP("PXRM DIALOG LISTS",$J),^TMP("PXRMXMZ",$J)
S CPRSONLY=1,SHOWREAS=0
D ASK(.ANS,"Search for coding system? ",6) I $D(DTOUT)!($D(DUOUT)) G ENX
I ANS="Y" D CODES Q:$D(DTOUT)&($D(DUOUT)) G:$D(DUOUT) FINDDIAL
ENF ;
K ANS D ASK(.ANS,"Search for Finding Item(s) used in dialog component(s)? ",8) G:$D(DTOUT)&($D(DUOUT)) ENX G:$D(DUOUT) FINDDIAL
I ANS="Y" D FINDING Q:$D(DTOUT)&($D(DUOUT)) G:$D(DUOUT) FINDDIAL
END ;
K ANS D ASK(.ANS,"Search for specific Reminder Dialog component(s)? ",9) G:$D(DTOUT)&($D(DUOUT)) ENX G:$D(DUOUT) ENF
I ANS="Y" D DIALOG Q:$D(DTOUT)&($D(DUOUT)) G:$D(DUOUT) ENF
ENC ;
D NEWCVOK^PXRMCVRL(.NEWP,DUZ) I 'NEWP S CPRSONLY=0 W !!,"Cannot search by CPRS Paramater(s), Reminder New Parameter not set to Yes" G ENR
K ANS D ASK(.ANS,"Search for Reminder Dialog by CPRS parameter(s)? ",10) G:$D(DTOUT)&($D(DUOUT)) ENX G:$D(DUOUT) ENF
I ANS="N" S CPRSONLY=0 G ENR
ENU ;
D CPRSLIST G:$D(DTOUT)&($D(DUOUT)) ENX G:$D(DUOUT)&(NEWP) ENC G:$D(DUOUT)&('NEWP) END
;
ENR ;
K ANS D ASK(.ANS,"Display match criteria on the report? ",13) G:$D(DTOUT)&($D(DUOUT)) ENX G:$D(DUOUT)&(NEWP) ENC G:$D(DUOUT)&('NEWP) END
I ANS="Y" S SHOWREAS=1
;
PROCESS ;
;build list of dialogs that contains the items that were selected
D BLDLIST
I '$D(^TMP("PXRM DIALOG LISTS",$J,"DIALOG")) W !,"No parent dialogs found." K ^TMP("PXRM DIALOG LISTS",$J) Q
;if searching all dialogs moved results to final array for the user.
I CPRSONLY=0 K ^TMP("PXRM DIALOG LISTS",$J,"COVER") D MERGE(.FINAL) G OUTPUT
;
;if searching for CPRS dialogs get dialogs for each users. get all templates for now.
D GETTDLST^PXRMCVRL(.TLIST)
D GETCPRSC(.FINAL)
D CPRSTDLG(.TEMPDIAL,.TLIST)
;
OUTPUT ;
I '$D(FINAL),'$D(TEMPDIAL) W !,"No Dialog Found" G ENX
D REPORT^PXRMDLR3(.FINAL,.TEMPDIAL,CPRSONLY,SHOWREAS)
D PRINT
ENX ;
;K ^TMP("PXRM DIALOG LISTS",$J)
Q
;
;
ADDDREAS(TYPE,IEN,REASON) ;add reason the dialog/dialog items in on the list
N CNT
I $D(^TMP("PXRM DIALOG LISTS",$J,TYPE,IEN,"SAVE REASON",REASON)) Q
S CNT=$O(^TMP("PXRM DIALOG LISTS",$J,TYPE,IEN,"REASON",""),-1)
S CNT=CNT+1,^TMP("PXRM DIALOG LISTS",$J,TYPE,IEN,"REASON",CNT)=REASON
S ^TMP("PXRM DIALOG LISTS",$J,TYPE,IEN,"SAVE REASON",REASON)=""
Q
;
ADDFREAS(TYPE,GBL,FIND,REASON) ;add the reason a finding item is on the list. For now only Taxonomies
N CNT
I $D(^TMP("PXRM DIALOG LISTS",$J,TYPE,GBL,FIND,"SAVE REASON",REASON)) Q
S CNT=$O(^TMP("PXRM DIALOG LISTS",$J,TYPE,GBL,FIND,"REASON",""),-1)
S CNT=CNT+1,^TMP("PXRM DIALOG LISTS",$J,TYPE,GBL,FIND,"REASON",CNT)=REASON
S ^TMP("PXRM DIALOG LISTS",$J,TYPE,GBL,FIND,"SAVE REASON",REASON)=""
Q
;
BLDLIST ;build list of dialogs that contains the selected search items
N CODE,FIND,FIEN,GBL,IEN,ITEM,PATH,REASON,SHOWPATH
S SHOWPATH=$S($G(^TMP("PXRM DIALOG LISTS",$J,"PATH"))="Y":1,1:0)
;find taxonomies for codes marked to be used in a dialog. Add taxonomies to the FINDING subscript
I $D(^TMP("PXRM DIALOG LISTS",$J,"CODES"))>0 S CODE="" F S CODE=$O(^TMP("PXRM DIALOG LISTS",$J,"CODES",CODE)) Q:CODE="" D
.S IEN=0 F S IEN=$O(^PXD(811.2,IEN)) Q:IEN'>0 I $D(^PXD(811.2,IEN,20,"AUID",CODE))>0 D
..S ^TMP("PXRM DIALOG LISTS",$J,"FINDING","PXD(811.2,",IEN)=""
..D ADDFREAS("FINDING","PXD(811.2,",IEN,"Coding System: "_CODE)
;
;search for finding items and add dialog IEN to ITEM subscript
I $D(^TMP("PXRM DIALOG LISTS",$J,"FINDING"))>0 D GETITEMS
;
;search for dialog that contain the items.
I $D(^TMP("PXRM DIALOG LISTS",$J,"ITEM"))>0 D
.S IEN=0 F S IEN=$O(^TMP("PXRM DIALOG LISTS",$J,"ITEM",IEN)) Q:IEN'>0 D
..S NODE=^TMP("PXRM DIALOG LISTS",$J,"ITEM",IEN)
..S REASON="Dialog "_$$RETTYPE($P(NODE,U,4))_": "_$P(NODE,U)_U_IEN D GETDIAL(IEN,REASON)
;
Q
;
BLDREAS(DARRAY,GBL,IEN) ;get finding item type and name
N RESULT,NAME
S RESULT=$G(DARRAY(GBL))_"."
S NAME=$P($G(@(U_GBL_IEN_",0)")),U) Q:NAME="" RESULT
Q RESULT_NAME
;
;find matching dialogs from a CPRS CoverSheet Parameter
CPRSCOM(FINAL,DLIST,NAME) ;
N DIEN,NODE
S FINAL(NAME,"CPRS Cover Sheet Reminder")=""
S DIEN=0 F S DIEN=$O(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN)) Q:DIEN'>0 D
.S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN)) I $P(NODE,U)="" Q
.I $D(DLIST("REMINDER",DIEN)) S FINAL(NAME,"CPRS Cover Sheet Reminder",$P(NODE,U))=DIEN_U_$P(NODE,U,1,4)
Q
;
;find matching dialogs from CPRS Template List
CPRSTDLG(TEMPDIAL,TLIST) ;
N DIEN,NODE
S DIEN=0 F S DIEN=$O(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN)) Q:DIEN'>0 D
.S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN)) I $P(NODE,U)="" Q
.I $D(TLIST("TEMPLATE",DIEN)) S TEMPDIAL($P(NODE,U))=DIEN_U_$P(NODE,U,1,4)
Q
;
CODES ;
N ALIST,CODESYS,CODE,DIR,DIROUT,DIRUT,INUM,LI,NUM,Y
D BLDCODE^PXRMDTAX("ALL",.CODESYS)
S CODE="",INUM=0 F S CODE=$O(CODESYS(CODE)) Q:CODE="" S INUM=INUM+1,ALIST(INUM)=INUM_" "_CODE
M DIR("A")=ALIST
S DIR("A")="Enter your list for search criteria"
S DIR(0)="LO^1:"_INUM
S DIR("??")=U_"D HELP^PXRMDLRH(7)"
W !!,"Select from the following coding systems:"
D ^DIR
I $D(DIROUT),$D(DIRUT) S DTOUT=1
I $D(DUOUT)!$D(DTOUT) Q
S NUM=$L(Y,",")-1
F IND=1:1:NUM D
. S LI=$P(Y,",",IND)
.I '$D(ALIST(LI)) Q
.S ^TMP("PXRM DIALOG LISTS",$J,"CODES",$P(ALIST(LI)," ",2))=""
Q
;
;build possible parameter values for CPRS CoverSheet pick lists
CPRSLIST ;
N ALIST,DIR,LIST,NUM,TYPE,X
K ^TMP("PXRM DIALOG LISTS",$J,"COVER")
S NUM=0
S NUM=NUM+1,ALIST(NUM)=" "_$J(NUM,4)_" - Division",LIST(NUM)="DIV"
S NUM=NUM+1,ALIST(NUM)=" "_$J(NUM,4)_" - Location",LIST(NUM)="LOC"
S NUM=NUM+1,ALIST(NUM)=" "_$J(NUM,4)_" - Service",LIST(NUM)="SRV"
S NUM=NUM+1,ALIST(NUM)=" "_$J(NUM,4)_" - System",LIST(NUM)="SYS"
S NUM=NUM+1,ALIST(NUM)=" "_$J(NUM,4)_" - User",LIST(NUM)="USR"
S NUM=NUM+1,ALIST(NUM)=" "_$J(NUM,4)_" - User Class",LIST(NUM)="CLASS"
M DIR("A")=ALIST
S DIR("A")="Enter your list for the report"
S DIR(0)="LO^1:"_NUM
D ^DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
F X=1:1:$L(Y,",")-1 D I $D(DTOUT)!($D(DUOUT)) Q
.I $D(DTOUT)!($D(DUOUT)) Q
.S NUM=$P(Y,",",X) I NUM'>0 Q
.S TYPE=$G(LIST(NUM)) I TYPE="" Q
.I TYPE="SYS" S ^TMP("PXRM DIALOG LISTS",$J,"COVER","System",0)=TYPE Q
.I TYPE="LOC" D GETVALS("^SC(","Location",TYPE) Q
.I TYPE="USR" D GETVALS("^VA(200,","User",TYPE) Q
.I TYPE="SRV" D GETVALS("^DIC(49,","Service",TYPE) Q
.I TYPE="CLASS" D GETVALS("^USR(8930,","User Class",TYPE) Q
.I TYPE="DIV" D GETVALS("^AUTTLOC(","Division",TYPE) Q
Q
;
DIALOG ;
N ANS,DIC
S DIC="^PXRMD(801.41,"
S DIC(0)="AEMQ"
S DIC("A")="Select Dialog Definition: "
D SELECT("ITEM",.DIC)
Q
;
FINDING ;
N FNUM,GBL,GNAME,IND,ITEMLIST,LI,LIST,NODE,NUM,PXRMCNT,SOURCE
S SOURCE("DIALOG")=""
;called to determine what finding types to search for
D FSEL^PXRMFRPT(.FNUM,.GBL,.GNAME,.SOURCE,.LIST)
S NUM=$L(LIST,",")-1
I NUM=0 Q
;called to determine individual finding items or all finding items for a type to search for.
D ISEL^PXRMFRPT(.FNUM,.GBL,.GNAME,.LIST,.ITEMLIST)
I '$D(ITEMLIST) Q
F IND=1:1:NUM D
. S LI=$P(LIST,",",IND)
. I '$D(ITEMLIST(FNUM(LI))) S ^TMP("PXRM DIALOG LISTS",$J,"FINDING",GBL(LI),"ALL")="" Q
. I $D(ITEMLIST(FNUM(LI))) D
.. S FIEN=""
.. F S FIEN=$O(ITEMLIST(FNUM(LI),FIEN)) Q:FIEN="" D
...S ^TMP("PXRM DIALOG LISTS",$J,"FINDING",GBL(LI),FIEN)=""
...I GBL(LI)'["ORD(101.41" Q
...;D FINDORD(GBL(LI),FIEN)
Q
;
FINDORD(GBL,FIEN) ;
N CNT,CNT1,DARRAY,IEN,LCNT,LIEN,NODE,PXRMORD
D FINDOPAR^ORQOUTL(.PXRMORD,FIEN) I '$D(PXRMORD) Q
S DARRAY("ORD(101.41,")="Q"
S REASON=$$BLDREAS(.DARRAY,GBL,FIEN)
S IEN=0 F S IEN=$O(PXRMORD(IEN)) Q:IEN'>0 D
.S NODE=$G(PXRMORD(IEN))
.S ^TMP("PXRM DIALOG LISTS",$J,"FINDING","ORD(101.41,",IEN)=""
.;D ADDFREAS("FINDING","ORD(101.41,",IEN,REASON)
.S ^TMP("PXRM DIALOG LISTS",$J,"FINDING","ORD(101.41,",IEN,"FIEN",FIEN)=NODE
Q
;
S CNT=0,LCNT=0 F S CNT=$O(PXRMORD(CNT)) Q:CNT'>0 D
.;I LCNT=0 S LCNT=CNT
.;I LCNT'=CNT D ADDFREAS("FINDING","ORD(101.41,",LIEN,REASON) S LCNT=CNT
.S CNT1=0,LIEN=0 F S CNT1=$O(PXRMORD(CNT,CNT1)) Q:CNT1'>0 D
..S NODE=$G(PXRMORD(CNT,CNT1)) Q:$P(NODE,U)'>0
..;I LIEN=0 S LIEN=$P(NODE,U)
..S ^TMP("PXRM DIALOG LISTS",$J,"FINDING","ORD(101.41,",$P(NODE,U))=""
..D ADDFREAS("FINDING","ORD(101.41,",$P(NODE,U),REASON)
..S ^TMP("PXRM DIALOG LISTS",$J,"FINDING","ORD(101.41,",$P(NODE,U),"SEQ")=CNT_U_CNT1
..;I LIEN'=$P(NODE,U) D ADDFREAS("FINDING","ORD(101.41,",LIEN,$P(NODE,U,5)_": "_$P(NODE,U,2)_U_$P(NODE,U)) S LIEN=$P(NODE,U)
M ^TMP("PXRM DIALOG LISTS",$J,"ORDER STRUCTURE")=PXRMORD
Q
;
GETCPRSL(DLIST,USER,LOC) ;
N CNT
D GETDLIST^PXRMCVRL(.DLIST,USER,$G(LOC))
Q
;
;loop through CPRS coversheet parameter to find CPRS dialogs.
GETCPRSC(FINAL) ;
N CLASS,DIALOGS,LVL,NAME,TEMP,TYPE
S TYPE="" F S TYPE=$O(^TMP("PXRM DIALOG LISTS",$J,"COVER",TYPE)) Q:TYPE="" D
.S NAME="" F S NAME=$O(^TMP("PXRM DIALOG LISTS",$J,"COVER",TYPE,NAME)) Q:NAME="" D
..S LVL=$G(^TMP("PXRM DIALOG LISTS",$J,"COVER",TYPE,NAME)) Q:LVL=""
..K DIALOGS
..I TYPE'="User Class" D GETLVRD^PXRMCVRL(.DIALOGS,LVL,"")
..I TYPE="User Class" D GETLVRD^PXRMCVRL(.DIALOGS,"CLASS",LVL)
..I TYPE="Package"!(TYPE="System") S TEMP=TYPE
..E S TEMP=TYPE_" ("_NAME_")"
..D CPRSCOM(.FINAL,.DIALOGS,TEMP)
Q
;
GETDIAL(IEN,REASON) ; recurrsive function that follows up the AD cross-references
;until either the item is not used or a dialog is reached
N CNT,NAME,NODE,DIEN,OIEN
S NODE=$G(^PXRMD(801.41,IEN,0))
S NAME=$P(NODE,U)
;S CNT=$O(PATH(""),-1) S CNT=CNT+1,PATH(CNT)=NODE
I $P($G(NODE),U,4)="R" S ^TMP("PXRM DIALOG LISTS",$J,"DIALOG",IEN)=NODE D ADDDREAS("DIALOG",IEN,REASON) Q
I $P($G(NODE),U,4)="S" D Q
.S DIEN=0 F S DIEN=$O(^PXRMD(801.41,"RG",IEN,DIEN)) Q:DIEN'>0 D
..;checked for result group attached to a dialog. This should not happened. Just a safety check
..S NODE=$G(^PXRMD(801.41,DIEN,0))
..I $P($G(NODE),U,4)="R" S ^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN)=NODE D ADDDREAS("DIALOG",DIEN,REASON) Q
..D GETDIAL(DIEN,REASON)
;search normal dialog structure
S DIEN=0,OIEN=0 F S DIEN=$O(^PXRMD(801.41,"AD",IEN,DIEN)) Q:DIEN'>0 D
.S NODE=$G(^PXRMD(801.41,DIEN,0))
.I $P($G(NODE),U,4)="R" S ^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN)=NODE D ADDDREAS("DIALOG",DIEN,REASON) Q
.D GETDIAL(DIEN,REASON)
;search replacement item structure
S DIEN=0 F S DIEN=$O(^PXRMD(801.41,"BLR",IEN,DIEN)) Q:DIEN'>0 D
.S NODE=$G(^PXRMD(801.41,DIEN,0))
.I $P($G(NODE),U,4)="R" S ^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN)=NODE D ADDDREAS("DIALOG",DIEN,REASON) Q
.;S:REASON'["item" REASON=$P(REASON,":")_" replacement item: "_$P(REASON,":",2)
.S:REASON'["item" REASON=$P(REASON,":")_" replacement item: "_NAME_U_$P(REASON,U,2)
.D GETDIAL(DIEN,REASON)
Q
GETITEMS ;
N DARRAY,FIND,FIEN,GBL,IEN,LOC,NODE,REASON,SUB,TYPE
;
S DARRAY("AUTTEDT(")="ED"
S DARRAY("AUTTEXAM(")="EX"
S DARRAY("AUTTHF(")="HF"
S DARRAY("AUTTIMM(")="IM"
S DARRAY("AUTTSK(")="ST"
S DARRAY("GMRD(120.51,")="VM"
S DARRAY("ORD(101.41,")="Q"
S DARRAY("YTT(601.71,")="MH"
S DARRAY("WV(790.404,")="WH"
S DARRAY("WV(790.1,")="WHR"
S DARRAY("PXD(811.2,")="TX"
S DARRAY("PXD(811.9,")="RD"
S DARRAY("PXRMD(811.5,")="TM"
;
S SUB="PXRM DIALOG FINDINGS LIST"
K ^TMP($J,SUB)
I $G(PXRMDMUL)=0!('$D(^TMP($J,SUB))) D
.D FARRAY^PXRMDUTL(SUB,"EGS") I '$D(^TMP($J,SUB)) D
..I $G(PXRMDAPI)=1 S PXRMFAIL=1 K ^TMP($J,SUB) Q
..W !,"Problem building finding list" K ^TMP($J,SUB) Q
S GBL="" F S GBL=$O(^TMP("PXRM DIALOG LISTS",$J,"FINDING",GBL)) Q:GBL="" D
.S FIND="" F S FIND=$O(^TMP("PXRM DIALOG LISTS",$J,"FINDING",GBL,FIND)) Q:FIND="" D
..;find dialog items for individaul findings for a gobal
..I +FIND>0 D Q
...S IEN=0 F S IEN=$O(^TMP($J,SUB,GBL,FIND,IEN)) Q:IEN'>0 D
....S NODE=$G(^PXRMD(801.41,IEN,0)),^TMP("PXRM DIALOG LISTS",$J,"ITEM",IEN)=NODE D
.....S REASON=$$BLDREAS(.DARRAY,GBL,FIND)
.....S LOC="" F S LOC=$O(^TMP($J,SUB,GBL,FIND,IEN,LOC)) Q:LOC="" D
......S TYPE=$S(LOC="A":"Additional Finding: ",LOC="B":"Branching Logic: ",LOC="O":"Orderable Item: ",LOC="RG":"Result Group: ",1:"Finding: ")
......D ADDDREAS("ITEM",IEN,TYPE_REASON_U_FIND_";"_GBL)
..;find dialog items for all finding for a gobal
..I FIND="ALL" D Q
...S FIEN=0 F S FIEN=$O(^TMP($J,SUB,GBL,FIEN)) Q:FIEN'>0 D
....S IEN=0 F S IEN=$O(^TMP($J,SUB,GBL,FIEN,IEN)) Q:IEN'>0 D
.....S NODE=$G(^PXRMD(801.41,IEN,0)),^TMP("PXRM DIALOG LISTS",$J,"ITEM",IEN)=NODE D
......S REASON=$$BLDREAS(.DARRAY,GBL,FIEN)
......S LOC="" F S LOC=$O(^TMP($J,SUB,GBL,FIEN,IEN,LOC)) Q:LOC="" D
.......S TYPE=$S(LOC="A":"Additional Finding: ",LOC="B":"Branching Logic: ",LOC="O":"Orderable Item: ",LOC="RG":"Result Group: ",1:"Finding: ")
.......D ADDDREAS("ITEM",IEN,TYPE_REASON_U_FIEN_";"_GBL)
I $G(PXRMDMUL)=0 K ^TMP($J,SUB)
Q
;
GETVALS(GBL,TYPE,INST) ;
N DIC,NUM,X
S DIC=GBL
S DIC(0)="AEMQ"
S DIC("A")="Select "_TYPE_": "
D SELECT(TYPE,.DIC,INST)
Q
;
MERGE(FINAL) ;
N DIEN,NAME,NODE
S NAME=$$GET1^DIQ(200,DUZ,.01)
S DIEN=0 F S DIEN=$O(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN)) Q:DIEN'>0 D
.S NODE=^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN)
.S FINAL(NAME,"Reminder Dialog",$P(NODE,U))=DIEN_U_$P(NODE,U,1,4)
Q
;
PRINT ;
N ANS,BOP,TO,X
S BOP=$$BORP^PXRMUTIL("B")
I BOP="B" D
. S X="IORESET"
. D ENDR^%ZISS
. D BROWSE^DDBR("^TMP(""PXRMXMZ"",$J)","NR","Reminder Dialog Search Report")
. W IORESET
. D KILL^%ZISS
I BOP="P" D GPRINT^PXRMUTIL("^TMP(""PXRMXMZ"",$J)")
;Ask the user if they want the report delivered through MailMan.
S ANS=$$ASKYN^PXRMEUT("N","Deliver the report as a MailMan message")
I ANS="1" D
. S TO(DUZ)=""
. D SEND^PXRMMSG("PXRMXMZ","Clinical Reminders Dialog Search Report",.TO,DUZ)
Q
;
PROMPTS(ITEM) ;
N ANS,EXT,GUIID,IEN,NUM,NAME,TYPE
S IEN=+Y,NAME=$P(ITEM,U,2),TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
I "PF"'[TYPE Q
S EXT=$S(TYPE="P":"Prompt",TYPE="F":"Forced Value",1:"") I EXT="" Q
D ASK(.ANS,NAME_" is a "_EXT_" search for all "_EXT_" of the same type? ",14) I $D(DTOUT)!($D(DUOUT)) Q
I ANS'="Y" Q
S GUIID=+$G(^PXRMD(801.41,IEN,46)) I GUIID'>0 Q
S NUM=0 F S NUM=$O(^PXRMD(801.41,NUM)) Q:NUM'>0 D
.I +$G(^PXRMD(801.41,NUM,46))'=GUIID Q
.S ^TMP("PXRM DIALOG LISTS",$J,"ITEM",NUM)=$P($G(^PXRMD(801.41,NUM,0)),U)
.W !,$P($G(^PXRMD(801.41,NUM,0)),U)_" added as search criteria."
Q
;
RETTYPE(T) ;
N RESULT
S RESULT=$S(T="E":"Element",T="G":"Group",T="P":"Prompt",T="F":"Forced Value",T="S":"Result Group",T="T":"Result Element","R":"Dialog",1:"")
Q RESULT
;
SELECT(TYPE,DIC,INST) ;
N CNT,NAME,SEL,Y
S SEL=1
W !
F Q:'SEL D
. D ^DIC
. I ($D(DTOUT))!($D(DUOUT)) S SEL=0 Q
. I Y=-1 S SEL=0 Q
. I TYPE="User" S ^TMP("PXRM DIALOG LISTS",$J,"COVER",TYPE,$P(Y,U,2))=INST_".`"_+Y Q
. I TYPE="Location" S ^TMP("PXRM DIALOG LISTS",$J,"COVER",TYPE,$P(Y,U,2))=INST_".`"_+Y Q
. I TYPE="Service" S ^TMP("PXRM DIALOG LISTS",$J,"COVER",TYPE,$P(Y,U,2))=INST_".`"_+Y Q
. I TYPE="User Class" S ^TMP("PXRM DIALOG LISTS",$J,"COVER",TYPE,$P(Y,U,2))=Y Q
. I TYPE="Division" D
..S NAME=$$GET1^DIQ(4,+Y,.01,"I"),^TMP("PXRM DIALOG LISTS",$J,"COVER",TYPE,NAME)=INST_".`"_+Y Q
. ;I TYPE'="USER" S ^TMP("PXRM DIALOG LISTS",$J,TYPE,+Y)=$P(Y,U,2)
. ;I TYPE="LOCATION" S SEL=0 Q
. S ^TMP("PXRM DIALOG LISTS",$J,TYPE,+Y)=$P(Y,U,2)
. I TYPE="ITEM" D PROMPTS(Y)
. I TYPE="USER" S ^TMP("PXRM DIALOG LISTS",$J,TYPE,$P(Y,U,2))=Y
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLR2 16143 printed Oct 16, 2024@17:45 Page 2
PXRMDLR2 ;SLC/AGP - Dialog reporting routine to find active CPRS dialogs ;09/14/2017
+1 ;;2.0;CLINICAL REMINDERS;**53,45**;Feb 04, 2005;Build 566
+2 QUIT
+3 ;
ASK(YESNO,PROMPT,NUM) ;
+1 NEW X,Y,TEXT
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="YA0"
+4 SET DIR("A")=PROMPT
+5 SET DIR("B")="N"
+6 SET DIR("?")="Enter Y or N. For detailed help type ??"
+7 SET DIR("??")=U_"D HELP^PXRMDLRH("_NUM_")"
+8 WRITE !
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DIROUT)
SET DTOUT=1
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+12 SET YESNO=$EXTRACT(Y(0))
+13 QUIT
+14 ;
FINDDIAL ;
+1 NEW DIROUT,DIRUT,DTOUT,DUOUT
+2 NEW ANS,CPRSONLY,DARRAY,DLIST,NAME,NEWP,PARAMS,FINAL,SHOWREAS,TEMPDIAL,TLIST,USER
+3 KILL ^TMP("PXRM DIALOG LISTS",$JOB),^TMP("PXRMXMZ",$JOB)
+4 SET CPRSONLY=1
SET SHOWREAS=0
+5 DO ASK(.ANS,"Search for coding system? ",6)
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO ENX
+6 IF ANS="Y"
DO CODES
if $DATA(DTOUT)&($DATA(DUOUT))
QUIT
if $DATA(DUOUT)
GOTO FINDDIAL
ENF ;
+1 KILL ANS
DO ASK(.ANS,"Search for Finding Item(s) used in dialog component(s)? ",8)
if $DATA(DTOUT)&($DATA(DUOUT))
GOTO ENX
if $DATA(DUOUT)
GOTO FINDDIAL
+2 IF ANS="Y"
DO FINDING
if $DATA(DTOUT)&($DATA(DUOUT))
QUIT
if $DATA(DUOUT)
GOTO FINDDIAL
END ;
+1 KILL ANS
DO ASK(.ANS,"Search for specific Reminder Dialog component(s)? ",9)
if $DATA(DTOUT)&($DATA(DUOUT))
GOTO ENX
if $DATA(DUOUT)
GOTO ENF
+2 IF ANS="Y"
DO DIALOG
if $DATA(DTOUT)&($DATA(DUOUT))
QUIT
if $DATA(DUOUT)
GOTO ENF
ENC ;
+1 DO NEWCVOK^PXRMCVRL(.NEWP,DUZ)
IF 'NEWP
SET CPRSONLY=0
WRITE !!,"Cannot search by CPRS Paramater(s), Reminder New Parameter not set to Yes"
GOTO ENR
+2 KILL ANS
DO ASK(.ANS,"Search for Reminder Dialog by CPRS parameter(s)? ",10)
if $DATA(DTOUT)&($DATA(DUOUT))
GOTO ENX
if $DATA(DUOUT)
GOTO ENF
+3 IF ANS="N"
SET CPRSONLY=0
GOTO ENR
ENU ;
+1 DO CPRSLIST
if $DATA(DTOUT)&($DATA(DUOUT))
GOTO ENX
if $DATA(DUOUT)&(NEWP)
GOTO ENC
if $DATA(DUOUT)&('NEWP)
GOTO END
+2 ;
ENR ;
+1 KILL ANS
DO ASK(.ANS,"Display match criteria on the report? ",13)
if $DATA(DTOUT)&($DATA(DUOUT))
GOTO ENX
if $DATA(DUOUT)&(NEWP)
GOTO ENC
if $DATA(DUOUT)&('NEWP)
GOTO END
+2 IF ANS="Y"
SET SHOWREAS=1
+3 ;
PROCESS ;
+1 ;build list of dialogs that contains the items that were selected
+2 DO BLDLIST
+3 IF '$DATA(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG"))
WRITE !,"No parent dialogs found."
KILL ^TMP("PXRM DIALOG LISTS",$JOB)
QUIT
+4 ;if searching all dialogs moved results to final array for the user.
+5 IF CPRSONLY=0
KILL ^TMP("PXRM DIALOG LISTS",$JOB,"COVER")
DO MERGE(.FINAL)
GOTO OUTPUT
+6 ;
+7 ;if searching for CPRS dialogs get dialogs for each users. get all templates for now.
+8 DO GETTDLST^PXRMCVRL(.TLIST)
+9 DO GETCPRSC(.FINAL)
+10 DO CPRSTDLG(.TEMPDIAL,.TLIST)
+11 ;
OUTPUT ;
+1 IF '$DATA(FINAL)
IF '$DATA(TEMPDIAL)
WRITE !,"No Dialog Found"
GOTO ENX
+2 DO REPORT^PXRMDLR3(.FINAL,.TEMPDIAL,CPRSONLY,SHOWREAS)
+3 DO PRINT
ENX ;
+1 ;K ^TMP("PXRM DIALOG LISTS",$J)
+2 QUIT
+3 ;
+4 ;
ADDDREAS(TYPE,IEN,REASON) ;add reason the dialog/dialog items in on the list
+1 NEW CNT
+2 IF $DATA(^TMP("PXRM DIALOG LISTS",$JOB,TYPE,IEN,"SAVE REASON",REASON))
QUIT
+3 SET CNT=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,TYPE,IEN,"REASON",""),-1)
+4 SET CNT=CNT+1
SET ^TMP("PXRM DIALOG LISTS",$JOB,TYPE,IEN,"REASON",CNT)=REASON
+5 SET ^TMP("PXRM DIALOG LISTS",$JOB,TYPE,IEN,"SAVE REASON",REASON)=""
+6 QUIT
+7 ;
ADDFREAS(TYPE,GBL,FIND,REASON) ;add the reason a finding item is on the list. For now only Taxonomies
+1 NEW CNT
+2 IF $DATA(^TMP("PXRM DIALOG LISTS",$JOB,TYPE,GBL,FIND,"SAVE REASON",REASON))
QUIT
+3 SET CNT=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,TYPE,GBL,FIND,"REASON",""),-1)
+4 SET CNT=CNT+1
SET ^TMP("PXRM DIALOG LISTS",$JOB,TYPE,GBL,FIND,"REASON",CNT)=REASON
+5 SET ^TMP("PXRM DIALOG LISTS",$JOB,TYPE,GBL,FIND,"SAVE REASON",REASON)=""
+6 QUIT
+7 ;
BLDLIST ;build list of dialogs that contains the selected search items
+1 NEW CODE,FIND,FIEN,GBL,IEN,ITEM,PATH,REASON,SHOWPATH
+2 SET SHOWPATH=$SELECT($GET(^TMP("PXRM DIALOG LISTS",$JOB,"PATH"))="Y":1,1:0)
+3 ;find taxonomies for codes marked to be used in a dialog. Add taxonomies to the FINDING subscript
+4 IF $DATA(^TMP("PXRM DIALOG LISTS",$JOB,"CODES"))>0
SET CODE=""
FOR
SET CODE=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"CODES",CODE))
if CODE=""
QUIT
Begin DoDot:1
+5 SET IEN=0
FOR
SET IEN=$ORDER(^PXD(811.2,IEN))
if IEN'>0
QUIT
IF $DATA(^PXD(811.2,IEN,20,"AUID",CODE))>0
Begin DoDot:2
+6 SET ^TMP("PXRM DIALOG LISTS",$JOB,"FINDING","PXD(811.2,",IEN)=""
+7 DO ADDFREAS("FINDING","PXD(811.2,",IEN,"Coding System: "_CODE)
End DoDot:2
End DoDot:1
+8 ;
+9 ;search for finding items and add dialog IEN to ITEM subscript
+10 IF $DATA(^TMP("PXRM DIALOG LISTS",$JOB,"FINDING"))>0
DO GETITEMS
+11 ;
+12 ;search for dialog that contain the items.
+13 IF $DATA(^TMP("PXRM DIALOG LISTS",$JOB,"ITEM"))>0
Begin DoDot:1
+14 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",IEN))
if IEN'>0
QUIT
Begin DoDot:2
+15 SET NODE=^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",IEN)
+16 SET REASON="Dialog "_$$RETTYPE($PIECE(NODE,U,4))_": "_$PIECE(NODE,U)_U_IEN
DO GETDIAL(IEN,REASON)
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT
+19 ;
BLDREAS(DARRAY,GBL,IEN) ;get finding item type and name
+1 NEW RESULT,NAME
+2 SET RESULT=$GET(DARRAY(GBL))_"."
+3 SET NAME=$PIECE($GET(@(U_GBL_IEN_",0)")),U)
if NAME=""
QUIT RESULT
+4 QUIT RESULT_NAME
+5 ;
+6 ;find matching dialogs from a CPRS CoverSheet Parameter
CPRSCOM(FINAL,DLIST,NAME) ;
+1 NEW DIEN,NODE
+2 SET FINAL(NAME,"CPRS Cover Sheet Reminder")=""
+3 SET DIEN=0
FOR
SET DIEN=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN))
if DIEN'>0
QUIT
Begin DoDot:1
+4 SET NODE=$GET(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN))
IF $PIECE(NODE,U)=""
QUIT
+5 IF $DATA(DLIST("REMINDER",DIEN))
SET FINAL(NAME,"CPRS Cover Sheet Reminder",$PIECE(NODE,U))=DIEN_U_$PIECE(NODE,U,1,4)
End DoDot:1
+6 QUIT
+7 ;
+8 ;find matching dialogs from CPRS Template List
CPRSTDLG(TEMPDIAL,TLIST) ;
+1 NEW DIEN,NODE
+2 SET DIEN=0
FOR
SET DIEN=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN))
if DIEN'>0
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN))
IF $PIECE(NODE,U)=""
QUIT
+4 IF $DATA(TLIST("TEMPLATE",DIEN))
SET TEMPDIAL($PIECE(NODE,U))=DIEN_U_$PIECE(NODE,U,1,4)
End DoDot:1
+5 QUIT
+6 ;
CODES ;
+1 NEW ALIST,CODESYS,CODE,DIR,DIROUT,DIRUT,INUM,LI,NUM,Y
+2 DO BLDCODE^PXRMDTAX("ALL",.CODESYS)
+3 SET CODE=""
SET INUM=0
FOR
SET CODE=$ORDER(CODESYS(CODE))
if CODE=""
QUIT
SET INUM=INUM+1
SET ALIST(INUM)=INUM_" "_CODE
+4 MERGE DIR("A")=ALIST
+5 SET DIR("A")="Enter your list for search criteria"
+6 SET DIR(0)="LO^1:"_INUM
+7 SET DIR("??")=U_"D HELP^PXRMDLRH(7)"
+8 WRITE !!,"Select from the following coding systems:"
+9 DO ^DIR
+10 IF $DATA(DIROUT)
IF $DATA(DIRUT)
SET DTOUT=1
+11 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+12 SET NUM=$LENGTH(Y,",")-1
+13 FOR IND=1:1:NUM
Begin DoDot:1
+14 SET LI=$PIECE(Y,",",IND)
+15 IF '$DATA(ALIST(LI))
QUIT
+16 SET ^TMP("PXRM DIALOG LISTS",$JOB,"CODES",$PIECE(ALIST(LI)," ",2))=""
End DoDot:1
+17 QUIT
+18 ;
+19 ;build possible parameter values for CPRS CoverSheet pick lists
CPRSLIST ;
+1 NEW ALIST,DIR,LIST,NUM,TYPE,X
+2 KILL ^TMP("PXRM DIALOG LISTS",$JOB,"COVER")
+3 SET NUM=0
+4 SET NUM=NUM+1
SET ALIST(NUM)=" "_$JUSTIFY(NUM,4)_" - Division"
SET LIST(NUM)="DIV"
+5 SET NUM=NUM+1
SET ALIST(NUM)=" "_$JUSTIFY(NUM,4)_" - Location"
SET LIST(NUM)="LOC"
+6 SET NUM=NUM+1
SET ALIST(NUM)=" "_$JUSTIFY(NUM,4)_" - Service"
SET LIST(NUM)="SRV"
+7 SET NUM=NUM+1
SET ALIST(NUM)=" "_$JUSTIFY(NUM,4)_" - System"
SET LIST(NUM)="SYS"
+8 SET NUM=NUM+1
SET ALIST(NUM)=" "_$JUSTIFY(NUM,4)_" - User"
SET LIST(NUM)="USR"
+9 SET NUM=NUM+1
SET ALIST(NUM)=" "_$JUSTIFY(NUM,4)_" - User Class"
SET LIST(NUM)="CLASS"
+10 MERGE DIR("A")=ALIST
+11 SET DIR("A")="Enter your list for the report"
+12 SET DIR(0)="LO^1:"_NUM
+13 DO ^DIR
+14 IF $DATA(DIROUT)
SET DTOUT=1
+15 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+16 FOR X=1:1:$LENGTH(Y,",")-1
Begin DoDot:1
+17 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+18 SET NUM=$PIECE(Y,",",X)
IF NUM'>0
QUIT
+19 SET TYPE=$GET(LIST(NUM))
IF TYPE=""
QUIT
+20 IF TYPE="SYS"
SET ^TMP("PXRM DIALOG LISTS",$JOB,"COVER","System",0)=TYPE
QUIT
+21 IF TYPE="LOC"
DO GETVALS("^SC(","Location",TYPE)
QUIT
+22 IF TYPE="USR"
DO GETVALS("^VA(200,","User",TYPE)
QUIT
+23 IF TYPE="SRV"
DO GETVALS("^DIC(49,","Service",TYPE)
QUIT
+24 IF TYPE="CLASS"
DO GETVALS("^USR(8930,","User Class",TYPE)
QUIT
+25 IF TYPE="DIV"
DO GETVALS("^AUTTLOC(","Division",TYPE)
QUIT
End DoDot:1
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+26 QUIT
+27 ;
DIALOG ;
+1 NEW ANS,DIC
+2 SET DIC="^PXRMD(801.41,"
+3 SET DIC(0)="AEMQ"
+4 SET DIC("A")="Select Dialog Definition: "
+5 DO SELECT("ITEM",.DIC)
+6 QUIT
+7 ;
FINDING ;
+1 NEW FNUM,GBL,GNAME,IND,ITEMLIST,LI,LIST,NODE,NUM,PXRMCNT,SOURCE
+2 SET SOURCE("DIALOG")=""
+3 ;called to determine what finding types to search for
+4 DO FSEL^PXRMFRPT(.FNUM,.GBL,.GNAME,.SOURCE,.LIST)
+5 SET NUM=$LENGTH(LIST,",")-1
+6 IF NUM=0
QUIT
+7 ;called to determine individual finding items or all finding items for a type to search for.
+8 DO ISEL^PXRMFRPT(.FNUM,.GBL,.GNAME,.LIST,.ITEMLIST)
+9 IF '$DATA(ITEMLIST)
QUIT
+10 FOR IND=1:1:NUM
Begin DoDot:1
+11 SET LI=$PIECE(LIST,",",IND)
+12 IF '$DATA(ITEMLIST(FNUM(LI)))
SET ^TMP("PXRM DIALOG LISTS",$JOB,"FINDING",GBL(LI),"ALL")=""
QUIT
+13 IF $DATA(ITEMLIST(FNUM(LI)))
Begin DoDot:2
+14 SET FIEN=""
+15 FOR
SET FIEN=$ORDER(ITEMLIST(FNUM(LI),FIEN))
if FIEN=""
QUIT
Begin DoDot:3
+16 SET ^TMP("PXRM DIALOG LISTS",$JOB,"FINDING",GBL(LI),FIEN)=""
+17 IF GBL(LI)'["ORD(101.41"
QUIT
+18 ;D FINDORD(GBL(LI),FIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
FINDORD(GBL,FIEN) ;
+1 NEW CNT,CNT1,DARRAY,IEN,LCNT,LIEN,NODE,PXRMORD
+2 DO FINDOPAR^ORQOUTL(.PXRMORD,FIEN)
IF '$DATA(PXRMORD)
QUIT
+3 SET DARRAY("ORD(101.41,")="Q"
+4 SET REASON=$$BLDREAS(.DARRAY,GBL,FIEN)
+5 SET IEN=0
FOR
SET IEN=$ORDER(PXRMORD(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+6 SET NODE=$GET(PXRMORD(IEN))
+7 SET ^TMP("PXRM DIALOG LISTS",$JOB,"FINDING","ORD(101.41,",IEN)=""
+8 ;D ADDFREAS("FINDING","ORD(101.41,",IEN,REASON)
+9 SET ^TMP("PXRM DIALOG LISTS",$JOB,"FINDING","ORD(101.41,",IEN,"FIEN",FIEN)=NODE
End DoDot:1
+10 QUIT
+11 ;
+12 SET CNT=0
SET LCNT=0
FOR
SET CNT=$ORDER(PXRMORD(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+13 ;I LCNT=0 S LCNT=CNT
+14 ;I LCNT'=CNT D ADDFREAS("FINDING","ORD(101.41,",LIEN,REASON) S LCNT=CNT
+15 SET CNT1=0
SET LIEN=0
FOR
SET CNT1=$ORDER(PXRMORD(CNT,CNT1))
if CNT1'>0
QUIT
Begin DoDot:2
+16 SET NODE=$GET(PXRMORD(CNT,CNT1))
if $PIECE(NODE,U)'>0
QUIT
+17 ;I LIEN=0 S LIEN=$P(NODE,U)
+18 SET ^TMP("PXRM DIALOG LISTS",$JOB,"FINDING","ORD(101.41,",$PIECE(NODE,U))=""
+19 DO ADDFREAS("FINDING","ORD(101.41,",$PIECE(NODE,U),REASON)
+20 SET ^TMP("PXRM DIALOG LISTS",$JOB,"FINDING","ORD(101.41,",$PIECE(NODE,U),"SEQ")=CNT_U_CNT1
+21 ;I LIEN'=$P(NODE,U) D ADDFREAS("FINDING","ORD(101.41,",LIEN,$P(NODE,U,5)_": "_$P(NODE,U,2)_U_$P(NODE,U)) S LIEN=$P(NODE,U)
End DoDot:2
End DoDot:1
+22 MERGE ^TMP("PXRM DIALOG LISTS",$JOB,"ORDER STRUCTURE")=PXRMORD
+23 QUIT
+24 ;
GETCPRSL(DLIST,USER,LOC) ;
+1 NEW CNT
+2 DO GETDLIST^PXRMCVRL(.DLIST,USER,$GET(LOC))
+3 QUIT
+4 ;
+5 ;loop through CPRS coversheet parameter to find CPRS dialogs.
GETCPRSC(FINAL) ;
+1 NEW CLASS,DIALOGS,LVL,NAME,TEMP,TYPE
+2 SET TYPE=""
FOR
SET TYPE=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"COVER",TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+3 SET NAME=""
FOR
SET NAME=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"COVER",TYPE,NAME))
if NAME=""
QUIT
Begin DoDot:2
+4 SET LVL=$GET(^TMP("PXRM DIALOG LISTS",$JOB,"COVER",TYPE,NAME))
if LVL=""
QUIT
+5 KILL DIALOGS
+6 IF TYPE'="User Class"
DO GETLVRD^PXRMCVRL(.DIALOGS,LVL,"")
+7 IF TYPE="User Class"
DO GETLVRD^PXRMCVRL(.DIALOGS,"CLASS",LVL)
+8 IF TYPE="Package"!(TYPE="System")
SET TEMP=TYPE
+9 IF '$TEST
SET TEMP=TYPE_" ("_NAME_")"
+10 DO CPRSCOM(.FINAL,.DIALOGS,TEMP)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
GETDIAL(IEN,REASON) ; recurrsive function that follows up the AD cross-references
+1 ;until either the item is not used or a dialog is reached
+2 NEW CNT,NAME,NODE,DIEN,OIEN
+3 SET NODE=$GET(^PXRMD(801.41,IEN,0))
+4 SET NAME=$PIECE(NODE,U)
+5 ;S CNT=$O(PATH(""),-1) S CNT=CNT+1,PATH(CNT)=NODE
+6 IF $PIECE($GET(NODE),U,4)="R"
SET ^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",IEN)=NODE
DO ADDDREAS("DIALOG",IEN,REASON)
QUIT
+7 IF $PIECE($GET(NODE),U,4)="S"
Begin DoDot:1
+8 SET DIEN=0
FOR
SET DIEN=$ORDER(^PXRMD(801.41,"RG",IEN,DIEN))
if DIEN'>0
QUIT
Begin DoDot:2
+9 ;checked for result group attached to a dialog. This should not happened. Just a safety check
+10 SET NODE=$GET(^PXRMD(801.41,DIEN,0))
+11 IF $PIECE($GET(NODE),U,4)="R"
SET ^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN)=NODE
DO ADDDREAS("DIALOG",DIEN,REASON)
QUIT
+12 DO GETDIAL(DIEN,REASON)
End DoDot:2
End DoDot:1
QUIT
+13 ;search normal dialog structure
+14 SET DIEN=0
SET OIEN=0
FOR
SET DIEN=$ORDER(^PXRMD(801.41,"AD",IEN,DIEN))
if DIEN'>0
QUIT
Begin DoDot:1
+15 SET NODE=$GET(^PXRMD(801.41,DIEN,0))
+16 IF $PIECE($GET(NODE),U,4)="R"
SET ^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN)=NODE
DO ADDDREAS("DIALOG",DIEN,REASON)
QUIT
+17 DO GETDIAL(DIEN,REASON)
End DoDot:1
+18 ;search replacement item structure
+19 SET DIEN=0
FOR
SET DIEN=$ORDER(^PXRMD(801.41,"BLR",IEN,DIEN))
if DIEN'>0
QUIT
Begin DoDot:1
+20 SET NODE=$GET(^PXRMD(801.41,DIEN,0))
+21 IF $PIECE($GET(NODE),U,4)="R"
SET ^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN)=NODE
DO ADDDREAS("DIALOG",DIEN,REASON)
QUIT
+22 ;S:REASON'["item" REASON=$P(REASON,":")_" replacement item: "_$P(REASON,":",2)
+23 if REASON'["item"
SET REASON=$PIECE(REASON,":")_" replacement item: "_NAME_U_$PIECE(REASON,U,2)
+24 DO GETDIAL(DIEN,REASON)
End DoDot:1
+25 QUIT
GETITEMS ;
+1 NEW DARRAY,FIND,FIEN,GBL,IEN,LOC,NODE,REASON,SUB,TYPE
+2 ;
+3 SET DARRAY("AUTTEDT(")="ED"
+4 SET DARRAY("AUTTEXAM(")="EX"
+5 SET DARRAY("AUTTHF(")="HF"
+6 SET DARRAY("AUTTIMM(")="IM"
+7 SET DARRAY("AUTTSK(")="ST"
+8 SET DARRAY("GMRD(120.51,")="VM"
+9 SET DARRAY("ORD(101.41,")="Q"
+10 SET DARRAY("YTT(601.71,")="MH"
+11 SET DARRAY("WV(790.404,")="WH"
+12 SET DARRAY("WV(790.1,")="WHR"
+13 SET DARRAY("PXD(811.2,")="TX"
+14 SET DARRAY("PXD(811.9,")="RD"
+15 SET DARRAY("PXRMD(811.5,")="TM"
+16 ;
+17 SET SUB="PXRM DIALOG FINDINGS LIST"
+18 KILL ^TMP($JOB,SUB)
+19 IF $GET(PXRMDMUL)=0!('$DATA(^TMP($JOB,SUB)))
Begin DoDot:1
+20 DO FARRAY^PXRMDUTL(SUB,"EGS")
IF '$DATA(^TMP($JOB,SUB))
Begin DoDot:2
+21 IF $GET(PXRMDAPI)=1
SET PXRMFAIL=1
KILL ^TMP($JOB,SUB)
QUIT
+22 WRITE !,"Problem building finding list"
KILL ^TMP($JOB,SUB)
QUIT
End DoDot:2
End DoDot:1
+23 SET GBL=""
FOR
SET GBL=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"FINDING",GBL))
if GBL=""
QUIT
Begin DoDot:1
+24 SET FIND=""
FOR
SET FIND=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"FINDING",GBL,FIND))
if FIND=""
QUIT
Begin DoDot:2
+25 ;find dialog items for individaul findings for a gobal
+26 IF +FIND>0
Begin DoDot:3
+27 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,SUB,GBL,FIND,IEN))
if IEN'>0
QUIT
Begin DoDot:4
+28 SET NODE=$GET(^PXRMD(801.41,IEN,0))
SET ^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",IEN)=NODE
Begin DoDot:5
+29 SET REASON=$$BLDREAS(.DARRAY,GBL,FIND)
+30 SET LOC=""
FOR
SET LOC=$ORDER(^TMP($JOB,SUB,GBL,FIND,IEN,LOC))
if LOC=""
QUIT
Begin DoDot:6
+31 SET TYPE=$SELECT(LOC="A":"Additional Finding: ",LOC="B":"Branching Logic: ",LOC="O":"Orderable Item: ",LOC="RG":"Result Group: ",1:"Finding: ")
+32 DO ADDDREAS("ITEM",IEN,TYPE_REASON_U_FIND_";"_GBL)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
+33 ;find dialog items for all finding for a gobal
+34 IF FIND="ALL"
Begin DoDot:3
+35 SET FIEN=0
FOR
SET FIEN=$ORDER(^TMP($JOB,SUB,GBL,FIEN))
if FIEN'>0
QUIT
Begin DoDot:4
+36 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,SUB,GBL,FIEN,IEN))
if IEN'>0
QUIT
Begin DoDot:5
+37 SET NODE=$GET(^PXRMD(801.41,IEN,0))
SET ^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",IEN)=NODE
Begin DoDot:6
+38 SET REASON=$$BLDREAS(.DARRAY,GBL,FIEN)
+39 SET LOC=""
FOR
SET LOC=$ORDER(^TMP($JOB,SUB,GBL,FIEN,IEN,LOC))
if LOC=""
QUIT
Begin DoDot:7
+40 SET TYPE=$SELECT(LOC="A":"Additional Finding: ",LOC="B":"Branching Logic: ",LOC="O":"Orderable Item: ",LOC="RG":"Result Group: ",1:"Finding: ")
+41 DO ADDDREAS("ITEM",IEN,TYPE_REASON_U_FIEN_";"_GBL)
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+42 IF $GET(PXRMDMUL)=0
KILL ^TMP($JOB,SUB)
+43 QUIT
+44 ;
GETVALS(GBL,TYPE,INST) ;
+1 NEW DIC,NUM,X
+2 SET DIC=GBL
+3 SET DIC(0)="AEMQ"
+4 SET DIC("A")="Select "_TYPE_": "
+5 DO SELECT(TYPE,.DIC,INST)
+6 QUIT
+7 ;
MERGE(FINAL) ;
+1 NEW DIEN,NAME,NODE
+2 SET NAME=$$GET1^DIQ(200,DUZ,.01)
+3 SET DIEN=0
FOR
SET DIEN=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN))
if DIEN'>0
QUIT
Begin DoDot:1
+4 SET NODE=^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN)
+5 SET FINAL(NAME,"Reminder Dialog",$PIECE(NODE,U))=DIEN_U_$PIECE(NODE,U,1,4)
End DoDot:1
+6 QUIT
+7 ;
PRINT ;
+1 NEW ANS,BOP,TO,X
+2 SET BOP=$$BORP^PXRMUTIL("B")
+3 IF BOP="B"
Begin DoDot:1
+4 SET X="IORESET"
+5 DO ENDR^%ZISS
+6 DO BROWSE^DDBR("^TMP(""PXRMXMZ"",$J)","NR","Reminder Dialog Search Report")
+7 WRITE IORESET
+8 DO KILL^%ZISS
End DoDot:1
+9 IF BOP="P"
DO GPRINT^PXRMUTIL("^TMP(""PXRMXMZ"",$J)")
+10 ;Ask the user if they want the report delivered through MailMan.
+11 SET ANS=$$ASKYN^PXRMEUT("N","Deliver the report as a MailMan message")
+12 IF ANS="1"
Begin DoDot:1
+13 SET TO(DUZ)=""
+14 DO SEND^PXRMMSG("PXRMXMZ","Clinical Reminders Dialog Search Report",.TO,DUZ)
End DoDot:1
+15 QUIT
+16 ;
PROMPTS(ITEM) ;
+1 NEW ANS,EXT,GUIID,IEN,NUM,NAME,TYPE
+2 SET IEN=+Y
SET NAME=$PIECE(ITEM,U,2)
SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+3 IF "PF"'[TYPE
QUIT
+4 SET EXT=$SELECT(TYPE="P":"Prompt",TYPE="F":"Forced Value",1:"")
IF EXT=""
QUIT
+5 DO ASK(.ANS,NAME_" is a "_EXT_" search for all "_EXT_" of the same type? ",14)
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+6 IF ANS'="Y"
QUIT
+7 SET GUIID=+$GET(^PXRMD(801.41,IEN,46))
IF GUIID'>0
QUIT
+8 SET NUM=0
FOR
SET NUM=$ORDER(^PXRMD(801.41,NUM))
if NUM'>0
QUIT
Begin DoDot:1
+9 IF +$GET(^PXRMD(801.41,NUM,46))'=GUIID
QUIT
+10 SET ^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",NUM)=$PIECE($GET(^PXRMD(801.41,NUM,0)),U)
+11 WRITE !,$PIECE($GET(^PXRMD(801.41,NUM,0)),U)_" added as search criteria."
End DoDot:1
+12 QUIT
+13 ;
RETTYPE(T) ;
+1 NEW RESULT
+2 SET RESULT=$SELECT(T="E":"Element",T="G":"Group",T="P":"Prompt",T="F":"Forced Value",T="S":"Result Group",T="T":"Result Element","R":"Dialog",1:"")
+3 QUIT RESULT
+4 ;
SELECT(TYPE,DIC,INST) ;
+1 NEW CNT,NAME,SEL,Y
+2 SET SEL=1
+3 WRITE !
+4 FOR
if 'SEL
QUIT
Begin DoDot:1
+5 DO ^DIC
+6 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET SEL=0
QUIT
+7 IF Y=-1
SET SEL=0
QUIT
+8 IF TYPE="User"
SET ^TMP("PXRM DIALOG LISTS",$JOB,"COVER",TYPE,$PIECE(Y,U,2))=INST_".`"_+Y
QUIT
+9 IF TYPE="Location"
SET ^TMP("PXRM DIALOG LISTS",$JOB,"COVER",TYPE,$PIECE(Y,U,2))=INST_".`"_+Y
QUIT
+10 IF TYPE="Service"
SET ^TMP("PXRM DIALOG LISTS",$JOB,"COVER",TYPE,$PIECE(Y,U,2))=INST_".`"_+Y
QUIT
+11 IF TYPE="User Class"
SET ^TMP("PXRM DIALOG LISTS",$JOB,"COVER",TYPE,$PIECE(Y,U,2))=Y
QUIT
+12 IF TYPE="Division"
Begin DoDot:2
+13 SET NAME=$$GET1^DIQ(4,+Y,.01,"I")
SET ^TMP("PXRM DIALOG LISTS",$JOB,"COVER",TYPE,NAME)=INST_".`"_+Y
QUIT
End DoDot:2
+14 ;I TYPE'="USER" S ^TMP("PXRM DIALOG LISTS",$J,TYPE,+Y)=$P(Y,U,2)
+15 ;I TYPE="LOCATION" S SEL=0 Q
+16 SET ^TMP("PXRM DIALOG LISTS",$JOB,TYPE,+Y)=$PIECE(Y,U,2)
+17 IF TYPE="ITEM"
DO PROMPTS(Y)
+18 IF TYPE="USER"
SET ^TMP("PXRM DIALOG LISTS",$JOB,TYPE,$PIECE(Y,U,2))=Y
End DoDot:1
+19 QUIT
+20 ;
