PXRMDLL ;SLC/PJH - REMINDER DIALOG LOADER ;Jul 12, 2022@14:08:54
;;2.0;CLINICAL REMINDERS;**10,6,12,17,18,26,47,45,65**;Feb 04, 2005;Build 438
;
; ICR API/FILE
; 3112 ^GMRD(120.51,
;
NEEDRPC(DITEM) ;
I $P($G(^PXRMD(801.41,DITEM,1)),U,5)'="" Q 1
I $D(^PXRMD(801.41,DITEM,3,"B"))>1 Q 1
I $D(^PXRMD(801.41,DITEM,10,"TYPE","P")) Q 1
I $D(^PXRMD(801.41,DITEM,10,"TYPE","F")) Q 1
I $D(^PXRMD(801.41,DITEM,35))>9 Q 1
Q 0
;
OK(DIEN) ;Check if mental health test is for GUI
I 'DIEN Q 0
Q $$MH^PXRMDLG5(DIEN)
;
TXT ;Format text
N NULL
S TEXT=DTXT(SUB),NULL=0
I ($E(TEXT)=" ")!(TEXT="") S NULL=1
I LAST,'NULL S TEXT="<br>"_TEXT
S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
Q
;
EXP(TIEN,DITEM,DSUB,DEXC,DMHEX,DRESL,DTXT,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,NDATA,DATANODE) ;Expand taxonomy codes
N ACNT,AHIS,ATYP,ARRAY,BOTH,CODES,CNT,COUNT,DDIS,DHIST,DPCE,DSUPP,DTAX,SUB,TAXTEXT,TEXT,TSEL
S TSEL=$P($G(^PXRMD(801.41,DITEM,"TAX")),U)
S DSUPP=$P($G(^PXRMD(801.41,DITEM,0)),U,11)
S DDIS=$S(DSUPP=1:"D",1:"S")
;
S TEXT=""
;Get taxonomy file details
;I TSEL'="N" S BOTH=$$TAX(TIEN,DITEM,TEXT,.ARRAY)
I TSEL'="N" D TAX(TIEN,DITEM,TEXT,.ARRAY)
I TSEL'="N",'$D(ARRAY) Q
S DHIS=$$AHIS(DITEM)
S COUNT=$S('$D(ARRAY):0,1:$O(ARRAY(""),-1))
;
;Build dialog from the returned array
;
S OCNT=OCNT+1
;this is new for Taxonomy selection types of N
I TSEL="N" D Q
.N LAST,TEXT
.S ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
.D SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT)
.D SETNDATA(DATANODE,NDATA)
.S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
..D TXT
..S OCNT=OCNT+1,ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
;Main Taxonomy prompt
;Default group indents and selection entry
;S TAXTEXT=ARRAY
;S ORY(OCNT)=1_U_DITEM_U_DSUB_U_"S"_U_DEXC
S ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC
;S $P(ORY(OCNT),U,16)=2,$P(ORY(OCNT),U,18)=$S(BOTH=1:2,1:0),$P(ORY(OCNT),U,8)=DHIS
S $P(ORY(OCNT),U,16)=2,$P(ORY(OCNT),U,18)=$S(COUNT>1:2,1:0),$P(ORY(OCNT),U,8)=DHIS
D SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT)
D SETNDATA(DATANODE,NDATA)
N LAST,TEXT
S TEXT=""
S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
.D TXT
.S OCNT=OCNT+1
.S ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
;
I COUNT<2 Q
;Taxonomy CPT/POV resolution prompts
S ACNT=0
F S ACNT=$O(ARRAY(ACNT)) Q:ACNT'>0 D
.;Prompt text
.S TAXTEXT=$P(ARRAY(ACNT),U),DPCE=$P(ARRAY(ACNT),U,4)
.;Historical/Current flag
.S AHIS=0 I $P(ARRAY(ACNT),U,3)=2 S AHIS=1
.;CPT/POV/SC
.S ATYP=$S($P(ARRAY(ACNT),U,2)=80:"POV",$P(ARRAY(ACNT),U,2)=81:"CPT",1:"SC")
.;S ATYP="POV" I $P(ARRAY(ACNT),U,2)=81 S ATYP="CPT"
.;Initial display
.;S DHIDE=0,DCHECK=0,DDIS=0
.;Construct ien for this level
.S DTAX=DSUB_"."_ACNT
.;I BOTH=0 Q
.;I COUNT<2 Q
.S DEXC=1
.S OCNT=OCNT+1
.S ORY(OCNT)=1_U_DITEM_U_DTAX_U_"T"_U_DEXC_U_U_ATYP_U_AHIS
.D SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT)
.D SETNDATA(DATANODE,NDATA)
.S OCNT=OCNT+1
.S ORY(OCNT)=2_U_DITEM_U_DTAX_U_TAXTEXT
Q
;
SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT) ;
I +$G(LINKITEM)>0 S $P(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$S(LINKFUNC'>0:$P(LINKACT,U),1:"")
S $P(ORY(OCNT),U,28)=$P($G(LINKACT),U,2)
Q
;
SETNDATA(DATANODE,NDATA) ;
S $P(ORY(OCNT),U,26)=$P(DATANODE,U)
S $P(ORY(OCNT),U,27)=+NDATA
Q
;
GROUP(DIEN,DSUB,CHECK,DATA,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,BLFAIL,NDATA,CHKSTAT) ;Dialog group
N DATANODE,DBOX,DCAP,DCHK,DENTRY,DEXC,DCCNT,DGIEN,DGRP,DGSEQ,DGSUB,DHIDE,DIND
N DINDPN,DMHEX,DRESL,DSHARE,SUB,DCOUNT,NOBL,ODATA,ODGIEN,DATANODE,TNDATA,TDCHK
N DSUPP
;N BLTXT,LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,RESULT
;Group caption text
I $G(DATA)="" S DATA=$G(^PXRMD(801.41,DIEN,0))
S DCAP=$P(DATA,U,5),DBOX=$P(DATA,U,6),DIND=$P(DATA,U,7)
S DSHARE=$P(DATA,U,8),DENTRY=$P(DATA,U,9),DHIDE=$P(DATA,U,10)
S DINDPN=$P(DATA,U,12) S:DINDPN="" DINDPN=0
S DBOX=$S(DBOX="Y":1,1:"")
;group header is display only if SUPPRESS CHECKBOX
S TDCHK=""
S DSUPP=$P(DATA,U,11),DCHK="S" I ('DHIDE)&(DSUPP) S DCHK="D",DHIDE=0
I DCHK="S",CHECK=1,NDATA'=1,$$DCHK^PXRMDLLC(DIEN)="C" S TDCHK="C"
I TDCHK="C"!(DSUPP="C") S DCHK="C"
;Default group setting to hide
I DHIDE="" S DHIDE=1
;
S DEXC=$P($G(^PXRMD(801.41,DIEN,2)),U,3)
S DRESL=$$RESGROUP^PXRMDLLB(DIEN)
;
S OCNT=OCNT+1,ORY(OCNT)=1_U_DIEN_U_DSUB_U_DCHK_U_DEXC
S CHKSTAT(DSUB)=DIEN_U_CHECK
S $P(ORY(OCNT),U,25)=$$NEEDRPC(DIEN)
I DRESL'="" S $P(ORY(OCNT),U,10)=DRESL K DRESL
S $P(ORY(OCNT),U,8)=$$AHIS(DIEN)
S $P(ORY(OCNT),U,15)=DHIDE,$P(ORY(OCNT),U,16)=DIND
S $P(ORY(OCNT),U,17)=DSHARE,$P(ORY(OCNT),U,18)=DENTRY
S $P(ORY(OCNT),U,19)=DBOX,$P(ORY(OCNT),U,20)=DCAP
S $P(ORY(OCNT),U,21)=DINDPN
I +$G(LINKITEM)>0 S $P(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$S(LINKFUNC'>0:$P(LINKACT,U),1:"")
S $P(ORY(OCNT),U,25)=$$NEEDRPC(DIEN)
S DATANODE=$G(^PXRMD(801.41,DIEN,"DATA"))
S $P(ORY(OCNT),U,26)=$P(DATANODE,U)
S $P(ORY(OCNT),U,27)=+NDATA
S $P(ORY(OCNT),U,28)=$P(LINKACT,U,2)
I DCHK="C"!(TDCHK="C") D CHKHLVL^PXRMDLLC(.ORY,OCNT,.CHKSTAT) K DCHK
;Create type 2 records if if here is additional group text
N LAST,TEXT
S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
.D TXT
.S OCNT=OCNT+1,ORY(OCNT)=2_U_DIEN_U_DSUB_U_TEXT
;Get dialog group sub-elements
;Linking variables
N BLTXT,LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
N DGCNT,DTYP,DSUPP,DDIS,IDENT S DGSEQ=0,DGCNT=0
F S DGSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ)) Q:'DGSEQ!(BLFAIL=1) D
.S DGSUB=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ,"")) Q:'DGSUB
.S DGCNT=DGCNT+1
.S DATA=$G(^PXRMD(801.41,DIEN,10,DGSUB,0))
.S CHECK=$S($P(DATA,U,12)'="":$P(DATA,U,12),1:1)
.K LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
.S LINK=$P($G(^PXRMD(801.41,DIEN,10,DGSUB,"LINK")),U) I LINK>0 D GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
.S DGIEN=$P(DATA,U,2) Q:'DGIEN
.;Check if element is disabled/invalid
.I $$ISDISAB(DGIEN)=1 Q
.S DEXC=$P(DATA,U,8)
.;
.S DATA=$G(^PXRMD(801.41,DGIEN,0))
.S DATANODE=$G(^PXRMD(801.41,DGIEN,"DATA"))
.S TNDATA=$P(DATANODE,U,2)
.I TNDATA="" S TNDATA=+NDATA
.;S ODGIEN=DGIEN
.I $D(^PXRMD(801.41,DGIEN,"BL")) D NREPLACE^PXRMDLLB(DFN,.DGIEN,.DATA,.BLFAIL,.BLTXT) I BLFAIL=1 Q
.;I $G(BLINK)>0 D
.;.K LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT S LINK=BLINK
.;.D GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
.;I ODGIEN=DGIEN,$G(LINK)="" D
.I $G(DGIEN)'>0 Q
.;Exclude from P/N
.;S DEXC=$P(DATA,U,8)
.I $P($G(^PXRMD(801.41,DGIEN,0)),U,16)'["WHR" D
..K DTXT S SUB=0 F S SUB=$O(^PXRMD(801.41,DGIEN,25,SUB)) Q:'SUB D
...S DTXT(SUB)=$G(^PXRMD(801.41,DGIEN,25,SUB,0))
..I $D(BLTXT)>9 D
...N SUB1
...S SUB=$O(DTXT("?"),-1),SUB1=0 F S SUB1=$O(BLTXT(SUB1)) Q:'SUB1 D
....S SUB=SUB+1,DTXT(SUB)=BLTXT(SUB1)
..K BLTXT
.;S DATA=$G(^PXRMD(801.41,DGIEN,0))
.;If the actual element is exclude from P/N override
.I $P($G(^PXRMD(801.41,DGIEN,2)),U,3) S DEXC=1
.S DTYP=$P(DATA,U,4),DSUPP=$P(DATA,U,11) Q:"EG"'[DTYP
.S DMHEX=$P(DATA,U,14)
.S DRESL=$$RESGROUP^PXRMDLLB(DGIEN)
.;S DRESL=$P(DATA,U,15)
.S DRES=$P($G(^PXRMD(801.41,DGIEN,1)),U,3)
.;Done Elsewhere (historical)
.S DHIS=$$AHIS(DGIEN)
.S DFIND=$P($G(^PXRMD(801.41,DGIEN,1)),U,5)
.S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
.S DPCE="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
.;If mental Health ignore if not GUI
.I DPCE="MH" Q:'$$OK(DFIEN)
.;S DGRP=DSUB_"."_DGSUB
.S DGRP=$S(ISNEWSTR:DSUB_"."_DGSEQ,1:DSUB_"."_DGSUB)
.;Taxonomy codes need expanding
.I DPCE="T",DTYP'="G" D EXP(DFIEN,DGIEN,DGRP,DEXC,DMHEX,DRESL,.DTXT,$G(LINKITEM),$G(LINKTYPE),$G(LINKFUNC),$G(LINKACT),TNDATA,DATANODE) Q
.;Translate vitals ien to PCE code - This will need a DBIA
.I DPCE="VIT" S DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
.;Embedded Dialog Group
.I DTYP="G" D GROUP(DGIEN,DGRP,CHECK,DATA,$G(LINKITEM),$G(LINKTYPE),$G(LINKFUNC),$G(LINKACT),.BLFAIL,.TNDATA,.CHKSTAT) Q
.S DDIS="S" I DSUPP=1 S DDIS="D"
.S TDCHK=""
.I DDIS="S",CHECK=1,TNDATA'=1,$$DCHK^PXRMDLLC(DGIEN)="C" S TDCHK="C"
.I DSUPP="C"!(TDCHK="C") S DDIS="C"
.S DGRP=$S(ISNEWSTR:DSUB_"."_DGSEQ,1:DSUB_"."_DGSUB),OCNT=OCNT+1
.S ORY(OCNT)=1_U_DGIEN_U_DGRP_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL_U_$G(DCOUNT)
.I +$G(LINKITEM)>0 S $P(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$S(LINKFUNC'>0:$P(LINKACT,U),1:"")
.S $P(ORY(OCNT),U,25)=$$NEEDRPC(DGIEN)
.S DATANODE=$G(^PXRMD(801.41,DGIEN,"DATA"))
.S $P(ORY(OCNT),U,26)=$P(DATANODE,U)
.S $P(ORY(OCNT),U,27)=+TNDATA
.S $P(ORY(OCNT),U,28)=$P($G(LINKACT),U,2)
.;
.I DDIS="C"!(TDCHK="C") D CHKHLVL^PXRMDLLC(.ORY,OCNT,.CHKSTAT)
.N LAST,TEXT
.S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
..D TXT
..S OCNT=OCNT+1,ORY(OCNT)=2_U_DGIEN_U_DGRP_U_TEXT
Q
;
ISDISAB(PXRMIEN) ;
N CNT,PXRMDATA,ERRORTXT,HEADER,MSG,MSGCNT,RESULT,STDFILES,TYPE,ZTSAVE
S PXRMDATA=$G(^PXRMD(801.41,PXRMIEN,0))
I +$P(PXRMDATA,U,3)=0 Q 0
I +$P(PXRMDATA,U,3)=2 Q 1
S HEADER="Disabled Dialog Item is being used in CPRS."
S TYPE=$P(PXRMDATA,U,4)
S CNT=1
S TYPE=$S(TYPE="E":"Element",TYPE="G":"Group",TYPE="R":"Result Group",1:"Item")
S ERRORTXT(CNT,0)="Reminder Dialog "_TYPE_" "_$P(PXRMDATA,U)_" is inactive."
D DIALDSAR^PXRMFRPT(.STDFILES) I '$D(STDFILES) G ISDISABX
S RESULT=$$DISABCHK^PXRMDLG6(PXRMIEN,.STDFILES,.MSG)
I '$D(MSG) G ISDISABX
S CNT=CNT+1,ERRORTXT(CNT,0)="",CNT=CNT+1
S MSGCNT=0
F S MSGCNT=$O(MSG(MSGCNT)) Q:MSGCNT'>0 D
.S CNT=CNT+1
.S ERRORTXT(CNT,0)=" "_$G(MSG(MSGCNT))
;
ISDISABX ;
S ZTSAVE("HEADER")=""
S ZTSAVE("ERRORTXT(")=""
D ERROR("Reminder Dialog disable check",.ZTSAVE)
Q 1
;
ERROR(DESC,ZTSAVE) ;
N ZTDESC,ZTDTH,ZTRTN,ZTIO
S ZTDESC=DESC
S ZTRTN="ERRORQ^PXRMDLL"
S ZTIO=""
S ZTDTH=$$NOW^XLFDT
D ^%ZTLOAD
Q
ERRORQ ;
M ^TMP("PXRMXMZ",$J)=ERRORTXT
D SEND^PXRMMSG("PXRMXMZ",HEADER,"",DUZ)
Q
;
LOAD(DIEN,DFN,VISITID) ;Load dialog questions into array
N BLFAIL,DATANODE,DARRAY,DATA,DITEM,DFIND,DFIEN,DFTYP,DPCE,DRES,DSEQ,DSUB,DTXT,DTYP,OCNT
N DDIS,DEXC,DHIDE,DCHECK,DDIS,DHIS,DMHEX,DRESL,DSUPP,SUB,IDENT,TXTCNT,REINDX
N CHKLVL,DIALOGIEN,CHECK,TDCHK,CHKSTAT
N LINKITEM,LINKTYPE,LINKFUNC,LINKACT,BLTXT,DATANODE,NDATA
I VISITID'="" D BLDVISIT^PXRMDLLC(VISITID)
N ISNEWSTR
;CHKLVL Switch to turn on new editing functionality.
S CHKLVL=1,NDATA=""
S DIALOGIEN=DIEN,BLFAIL=0
K ^TMP($J,"PXRM GEN FINDING",DIEN),^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN)
;Check Status of dialog
S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA=""
;If disabled ignore
I $$ISDISAB(DIEN)=1 Q
;Ignore if not a reminder dialog
I $P(DATA,U,4)'="R" Q
;check for disable evaluation disable if it contains branching logic
S REINDX=0
I $D(^XTMP("PXRM_DISEV",0)) D
.S ORY(1)=1_U_U_"1"_U_"D"_U_"1"_U_U_U_"0"_U_U
.S ORY(2)=2_U_U_"1"_U_"Dialog is disable for reminder re-indexing"
.S REINDX=1
I REINDX=1 Q
;List of PCE codes
S DARRAY("AUTTEDT(")="PED"
S DARRAY("AUTTEXAM(")="XAM"
S DARRAY("AUTTHF(")="HF"
S DARRAY("AUTTIMM(")="IMM"
S DARRAY("AUTTSK(")="SK"
S DARRAY("GMRD(120.51,")="VIT"
S DARRAY("ORD(101.41,")="Q"
S DARRAY("YTT(601.71,")="MH"
;AGP TODO before release ICD9 and CPT can be deleted
S DARRAY("ICD9(")="POV"
S DARRAY("ICPT(")="CPT"
S DARRAY("PXD(811.2,")="T"
S DARRAY("WV(790.1,")="WHR"
S DARRAY("PXRMD(801.46,")="GFIND"
;
;Get elements for the dialog
S DSEQ=0,OCNT=0,ISNEWSTR=0
I $P(DATA,U,16)="UCS" S ISNEWSTR=1
F S DSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ)) Q:'DSEQ!(BLFAIL=1) D
.S DSUB=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ,"")) Q:'DSUB
.S DATA=$G(^PXRMD(801.41,DIEN,10,DSUB,0))
.S CHECK=$S($P(DATA,U,12)'="":$P(DATA,U,12),1:1)
.S DITEM=$P(DATA,U,2) Q:DITEM=""
.;Ignore disabled elements
.S DATA=$G(^PXRMD(801.41,DITEM,0)) Q:DATA="" Q:$$ISDISAB(DITEM)=1
.S DATANODE=$G(^PXRMD(801.41,DITEM,"DATA"))
.S NDATA=$S(+$P(DATANODE,U,2)=1:1,1:0)
.;Branching logic
.I $D(^PXRMD(801.41,DITEM,"BL")) D NREPLACE^PXRMDLLB(DFN,.DITEM,.DATA,.BLFAIL,.BLTXT) I BLFAIL=1 Q
.I $G(DITEM)'>0 Q
.S DTYP=$P(DATA,U,4),DSUPP=$P(DATA,U,11)
.S DMHEX=$P(DATA,U,14)
.S DRESL=$$RESGROUP^PXRMDLLB(DITEM)
.;S DRESL=$P(DATA,U,15)
.K DTXT S SUB=0
.I '$D(DTXT) D
..S SUB=0
..F S SUB=$O(^PXRMD(801.41,DITEM,25,SUB)) Q:'SUB D
...S DTXT(SUB)=$G(^PXRMD(801.41,DITEM,25,SUB,0))
.I $D(BLTXT)>9 D
..N SUB1
..S SUB=$O(DTXT("?"),-1),SUB1=0 F S SUB1=$O(BLTXT(SUB1)) Q:'SUB1 D
...S SUB=SUB+1,DTXT(SUB)=BLTXT(SUB1)
..K BLTXT
.S DRES=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
.S DFIND=$P($G(^PXRMD(801.41,DITEM,1)),U,5)
.S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
.S DPCE="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
.K LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,RESULT
.;I $G(BLINK)>0 S LINK=BLINK D GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
.S LINK=$P($G(^PXRMD(801.41,DIEN,10,DSUB,"LINK")),U) I LINK>0 D GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
.;If mental Health ignore if not GUI
.I DPCE="MH" Q:'$$OK(DFIEN)
.;Exclude from PN
.S DEXC=$P($G(^PXRMD(801.41,DITEM,2)),U,3)
.;Done Elsewhere (historical)
.S DHIS=$$AHIS(DITEM)
.;Taxonomy codes need expanding
.I DPCE="T",DTYP'="G" D EXP(DFIEN,DITEM,$S(ISNEWSTR:DSEQ,1:DSUB),DEXC,DMHEX,DRESL,.DTXT,$G(LINKITEM),$G(LINKTYPE),$G(LINKFUNC),$G(LINKACT),NDATA,DATANODE) Q
.;Translate vitals ien to PCE code - This will need a DBIA
.I DPCE="VIT" S DFIEN=$P($G(^GMRD(120.51,DFIEN,0)),U,7)
.;Dialog Group
.;I DTYP="G" D GROUP(DITEM,DSUB,CHECK,DATA,$G(LINKITEM),$G(LINKTYPE),$G(LINKFUNC),$G(LINKACT),.BLFAIL,.NDATA,.CHKSTAT) Q
.I DTYP="G" D GROUP(DITEM,$S(ISNEWSTR:DSEQ,1:DSUB),CHECK,DATA,$G(LINKITEM),$G(LINKTYPE),$G(LINKFUNC),$G(LINKACT),.BLFAIL,.NDATA,.CHKSTAT) Q
.;Dialog type/text and resolution
.S OCNT=OCNT+1,DDIS="S"
.I DSUPP=1 S DDIS="D"
.S TDCHK=""
.I DDIS="S",CHECK=1,NDATA'=1,$$DCHK^PXRMDLLC(DIEN)="C" S TDCHK="C"
.I DSUPP="C"!(TDCHK="C") S DDIS="C"
.S ORY(OCNT)=1_U_DITEM_U_$S(ISNEWSTR:DSEQ,1:DSUB)_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
.I +$G(LINKITEM)>0 S $P(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$S(LINKFUNC'>0:$P(LINKACT,U),1:"")
.S $P(ORY(OCNT),U,25)=$$NEEDRPC(DITEM)
.;S DATANODE=$G(^PXRMD(801.41,DITEM,"DATA"))
.S $P(ORY(OCNT),U,26)=$P(DATANODE,U)
.S $P(ORY(OCNT),U,27)=+NDATA
.S $P(ORY(OCNT),U,28)=$P($G(LINKACT),U,2)
.I DDIS="C"!(TDCHK="C") D CHKHLVL^PXRMDLLC(.ORY,OCNT,.CHKSTAT)
.N LAST,TEXT
.S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
..D TXT
..S OCNT=OCNT+1,ORY(OCNT)=2_U_DITEM_U_$S(ISNEWSTR:DSEQ,1:DSUB)_U_TEXT
K ^TMP($J,"PXRM DIALOG VISIT INFO")
I BLFAIL=1 D Q
.K OCNT,ORY
.S ORY(1)=1_U_U_"1"_U_"D"_U_"1"_U_U_U_"0"_U_U
.S ORY(2)=2_U_U_"1"_U_"Clinical Reminder evaluation error; this reminder dialog cannot be processed.<br>Please contact the reminder manager for assistance."
Q
;
TAX(TXIEN,DITEM,TEXT,ARRAY) ;Return list of resolutions/codes for taxonomy
N CNT,DXNODE,DTXT,FAIL,HISTIEN,NODE,NUM,PRNODE,RESULT,RESVALUE,TCUR,TNAME,TSEL,TSCT,TYPE
N TDTXT,TDHTXT,TPTXT,TPHTXT,TSCTXT
;
;Get taxonomy name
;S RESULT=0
S TNAME=$P($G(^PXD(811.2,TXIEN,0)),U,1)
I $P($G(^PXD(811.2,TXIEN,0)),U,6)=1 D TAXERROR(DITEM,TXIEN) Q
;
S TDX=$$TOK^PXRMDTAX(TXIEN,"POV")
S TPR=$$TOK^PXRMDTAX(TXIEN,"CPT")
S TSCT=$$TOK^PXRMDTAX(TXIEN,"SC")
S NODE=$G(^PXRMD(801.41,DITEM,"TAX"))
S TSEL=$P(NODE,U)
D TAXERROR(DITEM,TXIEN)
;
S DTXT=""
;Taxonomy dialog text
I DTXT="" S DTXT=$P(NODE,U,4)
;default to taxonomy description if null
I DTXT="" S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,2)
;default to taxonomy name if null
I DTXT="" S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,1)
;
S CNT=0,ARRAY=DTXT
;
;make sure dialog is set to display diagnoses/procedure selection list
I TDX S TDX=$S("AD"[TSEL:1,1:0)
I TPR S TPR=$S("AP"[TSEL:1,1:0)
I TSCT S TSCT=$S("AS"[TSEL:1,1:0)
;I TDX,TPR,TSCT S RESULT=1
S HISTIEN=$O(^PXRMD(801.9,"B","DONE ELSEWHERE (HISTORICAL)",""))
S RESVALUE=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
S TCUR=$S(RESVALUE'=HISTIEN:1,1:0)
;Diagnoses
I TDX D
.S TDTXT=$P($G(^PXRMD(801.41,DITEM,"POV")),U) S:TDTXT="" TDTXT=TNAME_$S(TCUR=1:"",1:" (HISTORICAL)")
.S CNT=CNT+1,ARRAY(CNT)=TDTXT_U_80_U_$S(TCUR=1:1,1:2)_U_"POV"
;Procedures
I TPR D
.S TPTXT=$P($G(^PXRMD(801.41,DITEM,"CPT")),U) S:TPTXT="" TPTXT=TNAME_$S(TCUR=1:"",1:" (HISTORICAL)")
.S CNT=CNT+1,ARRAY(CNT)=TPTXT_U_81_U_$S(TCUR=1:1,1:2)_U_"CPT"
I TSCT D
.S TSCTXT="SNOMED SECTION" S:TSCTXT="" TSCTXT=TNAME_$S(TCUR=1:"",1:" (HISTORICAL)")
.S CNT=CNT+1,ARRAY(CNT)=TSCTXT_U_750.1_U_$S(TCUR=1:1,1:2)_U_"SC"
;
Q
;
TAXERROR(DIEN,TIEN) ;
N CNT,DNAME,ERRORTXT,FAIL,HEADER,LINE,NIN,NOUT,OUTPUT,TEMP,TNAME
S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U) Q:DNAME=""
S TNAME=$P($G(^PXD(811.2,TIEN,0)),U)
S HEADER="Problem with dialog in CPRS"
S FAIL=$$CHECKER^PXRMDTAX(DIEN,TIEN,15,.OUTPUT) I FAIL="" Q
S NIN=$O(OUTPUT(""),-1)
D FORMAT^PXRMTEXT(1,75,NIN,.OUTPUT,.NOUT,.TEMP)
S CNT=0 F LINE=1:1:NOUT S CNT=CNT+1,ERRORTXT(CNT,0)=TEMP(LINE)
S CNT=CNT+1,ERRORTXT(CNT,0)="Please review and correct either the taxonomy or the dialog."
S ZTSAVE("HEADER")="",ZTSAVE("ERRORTXT(")=""
D ERROR("Reminder Dialog/Taxonomy Loader check",.ZTSAVE)
Q
;
AHIS(DITEM) ;
N RSIEN,RSNAM
S RSIEN=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
I RSIEN="" Q 0
S RSNAM=$P($G(^PXRMD(801.9,RSIEN,0)),U)
I RSNAM["DONE ELSEWHERE" Q 1
I RSNAM="CONTRAINDICATED" Q 2
I RSNAM["REFUSED" Q 3
N GUI,PIEN,PFOUND
S PIEN=0,PFOUND=0
F S PIEN=$O(^PXRMD(801.41,DITEM,10,"D",PIEN)) Q:'PIEN D Q:PFOUND
.;Ignore elements and groups
.I "EG"[$P($G(^PXRMD(801.41,PIEN,0)),U,4) Q
.;GUI Process
.S GUI=$P($G(^PXRMD(801.41,PIEN,46)),U) Q:'GUI
.;Check if this is PXRM VISIT DATE (or a copy of it)
.I $P($G(^PXRMD(801.42,GUI,0)),U)="VST_DATE" S PFOUND=1
Q PFOUND
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLL 17818 printed Oct 16, 2024@17:44:53 Page 2
PXRMDLL ;SLC/PJH - REMINDER DIALOG LOADER ;Jul 12, 2022@14:08:54
+1 ;;2.0;CLINICAL REMINDERS;**10,6,12,17,18,26,47,45,65**;Feb 04, 2005;Build 438
+2 ;
+3 ; ICR API/FILE
+4 ; 3112 ^GMRD(120.51,
+5 ;
NEEDRPC(DITEM) ;
+1 IF $PIECE($GET(^PXRMD(801.41,DITEM,1)),U,5)'=""
QUIT 1
+2 IF $DATA(^PXRMD(801.41,DITEM,3,"B"))>1
QUIT 1
+3 IF $DATA(^PXRMD(801.41,DITEM,10,"TYPE","P"))
QUIT 1
+4 IF $DATA(^PXRMD(801.41,DITEM,10,"TYPE","F"))
QUIT 1
+5 IF $DATA(^PXRMD(801.41,DITEM,35))>9
QUIT 1
+6 QUIT 0
+7 ;
OK(DIEN) ;Check if mental health test is for GUI
+1 IF 'DIEN
QUIT 0
+2 QUIT $$MH^PXRMDLG5(DIEN)
+3 ;
TXT ;Format text
+1 NEW NULL
+2 SET TEXT=DTXT(SUB)
SET NULL=0
+3 IF ($EXTRACT(TEXT)=" ")!(TEXT="")
SET NULL=1
+4 IF LAST
IF 'NULL
SET TEXT="<br>"_TEXT
+5 SET TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
+6 SET LAST=0
IF NULL
SET TEXT="<br>"_TEXT
SET LAST=1
+7 QUIT
+8 ;
EXP(TIEN,DITEM,DSUB,DEXC,DMHEX,DRESL,DTXT,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,NDATA,DATANODE) ;Expand taxonomy codes
+1 NEW ACNT,AHIS,ATYP,ARRAY,BOTH,CODES,CNT,COUNT,DDIS,DHIST,DPCE,DSUPP,DTAX,SUB,TAXTEXT,TEXT,TSEL
+2 SET TSEL=$PIECE($GET(^PXRMD(801.41,DITEM,"TAX")),U)
+3 SET DSUPP=$PIECE($GET(^PXRMD(801.41,DITEM,0)),U,11)
+4 SET DDIS=$SELECT(DSUPP=1:"D",1:"S")
+5 ;
+6 SET TEXT=""
+7 ;Get taxonomy file details
+8 ;I TSEL'="N" S BOTH=$$TAX(TIEN,DITEM,TEXT,.ARRAY)
+9 IF TSEL'="N"
DO TAX(TIEN,DITEM,TEXT,.ARRAY)
+10 IF TSEL'="N"
IF '$DATA(ARRAY)
QUIT
+11 SET DHIS=$$AHIS(DITEM)
+12 SET COUNT=$SELECT('$DATA(ARRAY):0,1:$ORDER(ARRAY(""),-1))
+13 ;
+14 ;Build dialog from the returned array
+15 ;
+16 SET OCNT=OCNT+1
+17 ;this is new for Taxonomy selection types of N
+18 IF TSEL="N"
Begin DoDot:1
+19 NEW LAST,TEXT
+20 SET ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
+21 DO SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT)
+22 DO SETNDATA(DATANODE,NDATA)
+23 SET SUB=0
SET LAST=0
FOR
SET SUB=$ORDER(DTXT(SUB))
if 'SUB
QUIT
Begin DoDot:2
+24 DO TXT
+25 SET OCNT=OCNT+1
SET ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
End DoDot:2
End DoDot:1
QUIT
+26 ;Main Taxonomy prompt
+27 ;Default group indents and selection entry
+28 ;S TAXTEXT=ARRAY
+29 ;S ORY(OCNT)=1_U_DITEM_U_DSUB_U_"S"_U_DEXC
+30 SET ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC
+31 ;S $P(ORY(OCNT),U,16)=2,$P(ORY(OCNT),U,18)=$S(BOTH=1:2,1:0),$P(ORY(OCNT),U,8)=DHIS
+32 SET $PIECE(ORY(OCNT),U,16)=2
SET $PIECE(ORY(OCNT),U,18)=$SELECT(COUNT>1:2,1:0)
SET $PIECE(ORY(OCNT),U,8)=DHIS
+33 DO SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT)
+34 DO SETNDATA(DATANODE,NDATA)
+35 NEW LAST,TEXT
+36 SET TEXT=""
+37 SET SUB=0
SET LAST=0
FOR
SET SUB=$ORDER(DTXT(SUB))
if 'SUB
QUIT
Begin DoDot:1
+38 DO TXT
+39 SET OCNT=OCNT+1
+40 SET ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
End DoDot:1
+41 ;
+42 IF COUNT<2
QUIT
+43 ;Taxonomy CPT/POV resolution prompts
+44 SET ACNT=0
+45 FOR
SET ACNT=$ORDER(ARRAY(ACNT))
if ACNT'>0
QUIT
Begin DoDot:1
+46 ;Prompt text
+47 SET TAXTEXT=$PIECE(ARRAY(ACNT),U)
SET DPCE=$PIECE(ARRAY(ACNT),U,4)
+48 ;Historical/Current flag
+49 SET AHIS=0
IF $PIECE(ARRAY(ACNT),U,3)=2
SET AHIS=1
+50 ;CPT/POV/SC
+51 SET ATYP=$SELECT($PIECE(ARRAY(ACNT),U,2)=80:"POV",$PIECE(ARRAY(ACNT),U,2)=81:"CPT",1:"SC")
+52 ;S ATYP="POV" I $P(ARRAY(ACNT),U,2)=81 S ATYP="CPT"
+53 ;Initial display
+54 ;S DHIDE=0,DCHECK=0,DDIS=0
+55 ;Construct ien for this level
+56 SET DTAX=DSUB_"."_ACNT
+57 ;I BOTH=0 Q
+58 ;I COUNT<2 Q
+59 SET DEXC=1
+60 SET OCNT=OCNT+1
+61 SET ORY(OCNT)=1_U_DITEM_U_DTAX_U_"T"_U_DEXC_U_U_ATYP_U_AHIS
+62 DO SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT)
+63 DO SETNDATA(DATANODE,NDATA)
+64 SET OCNT=OCNT+1
+65 SET ORY(OCNT)=2_U_DITEM_U_DTAX_U_TAXTEXT
End DoDot:1
+66 QUIT
+67 ;
SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT) ;
+1 IF +$GET(LINKITEM)>0
SET $PIECE(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$SELECT(LINKFUNC'>0:$PIECE(LINKACT,U),1:"")
+2 SET $PIECE(ORY(OCNT),U,28)=$PIECE($GET(LINKACT),U,2)
+3 QUIT
+4 ;
SETNDATA(DATANODE,NDATA) ;
+1 SET $PIECE(ORY(OCNT),U,26)=$PIECE(DATANODE,U)
+2 SET $PIECE(ORY(OCNT),U,27)=+NDATA
+3 QUIT
+4 ;
GROUP(DIEN,DSUB,CHECK,DATA,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,BLFAIL,NDATA,CHKSTAT) ;Dialog group
+1 NEW DATANODE,DBOX,DCAP,DCHK,DENTRY,DEXC,DCCNT,DGIEN,DGRP,DGSEQ,DGSUB,DHIDE,DIND
+2 NEW DINDPN,DMHEX,DRESL,DSHARE,SUB,DCOUNT,NOBL,ODATA,ODGIEN,DATANODE,TNDATA,TDCHK
+3 NEW DSUPP
+4 ;N BLTXT,LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,RESULT
+5 ;Group caption text
+6 IF $GET(DATA)=""
SET DATA=$GET(^PXRMD(801.41,DIEN,0))
+7 SET DCAP=$PIECE(DATA,U,5)
SET DBOX=$PIECE(DATA,U,6)
SET DIND=$PIECE(DATA,U,7)
+8 SET DSHARE=$PIECE(DATA,U,8)
SET DENTRY=$PIECE(DATA,U,9)
SET DHIDE=$PIECE(DATA,U,10)
+9 SET DINDPN=$PIECE(DATA,U,12)
if DINDPN=""
SET DINDPN=0
+10 SET DBOX=$SELECT(DBOX="Y":1,1:"")
+11 ;group header is display only if SUPPRESS CHECKBOX
+12 SET TDCHK=""
+13 SET DSUPP=$PIECE(DATA,U,11)
SET DCHK="S"
IF ('DHIDE)&(DSUPP)
SET DCHK="D"
SET DHIDE=0
+14 IF DCHK="S"
IF CHECK=1
IF NDATA'=1
IF $$DCHK^PXRMDLLC(DIEN)="C"
SET TDCHK="C"
+15 IF TDCHK="C"!(DSUPP="C")
SET DCHK="C"
+16 ;Default group setting to hide
+17 IF DHIDE=""
SET DHIDE=1
+18 ;
+19 SET DEXC=$PIECE($GET(^PXRMD(801.41,DIEN,2)),U,3)
+20 SET DRESL=$$RESGROUP^PXRMDLLB(DIEN)
+21 ;
+22 SET OCNT=OCNT+1
SET ORY(OCNT)=1_U_DIEN_U_DSUB_U_DCHK_U_DEXC
+23 SET CHKSTAT(DSUB)=DIEN_U_CHECK
+24 SET $PIECE(ORY(OCNT),U,25)=$$NEEDRPC(DIEN)
+25 IF DRESL'=""
SET $PIECE(ORY(OCNT),U,10)=DRESL
KILL DRESL
+26 SET $PIECE(ORY(OCNT),U,8)=$$AHIS(DIEN)
+27 SET $PIECE(ORY(OCNT),U,15)=DHIDE
SET $PIECE(ORY(OCNT),U,16)=DIND
+28 SET $PIECE(ORY(OCNT),U,17)=DSHARE
SET $PIECE(ORY(OCNT),U,18)=DENTRY
+29 SET $PIECE(ORY(OCNT),U,19)=DBOX
SET $PIECE(ORY(OCNT),U,20)=DCAP
+30 SET $PIECE(ORY(OCNT),U,21)=DINDPN
+31 IF +$GET(LINKITEM)>0
SET $PIECE(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$SELECT(LINKFUNC'>0:$PIECE(LINKACT,U),1:"")
+32 SET $PIECE(ORY(OCNT),U,25)=$$NEEDRPC(DIEN)
+33 SET DATANODE=$GET(^PXRMD(801.41,DIEN,"DATA"))
+34 SET $PIECE(ORY(OCNT),U,26)=$PIECE(DATANODE,U)
+35 SET $PIECE(ORY(OCNT),U,27)=+NDATA
+36 SET $PIECE(ORY(OCNT),U,28)=$PIECE(LINKACT,U,2)
+37 IF DCHK="C"!(TDCHK="C")
DO CHKHLVL^PXRMDLLC(.ORY,OCNT,.CHKSTAT)
KILL DCHK
+38 ;Create type 2 records if if here is additional group text
+39 NEW LAST,TEXT
+40 SET SUB=0
SET LAST=0
FOR
SET SUB=$ORDER(DTXT(SUB))
if 'SUB
QUIT
Begin DoDot:1
+41 DO TXT
+42 SET OCNT=OCNT+1
SET ORY(OCNT)=2_U_DIEN_U_DSUB_U_TEXT
End DoDot:1
+43 ;Get dialog group sub-elements
+44 ;Linking variables
+45 NEW BLTXT,LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
+46 NEW DGCNT,DTYP,DSUPP,DDIS,IDENT
SET DGSEQ=0
SET DGCNT=0
+47 FOR
SET DGSEQ=$ORDER(^PXRMD(801.41,DIEN,10,"B",DGSEQ))
if 'DGSEQ!(BLFAIL=1)
QUIT
Begin DoDot:1
+48 SET DGSUB=$ORDER(^PXRMD(801.41,DIEN,10,"B",DGSEQ,""))
if 'DGSUB
QUIT
+49 SET DGCNT=DGCNT+1
+50 SET DATA=$GET(^PXRMD(801.41,DIEN,10,DGSUB,0))
+51 SET CHECK=$SELECT($PIECE(DATA,U,12)'="":$PIECE(DATA,U,12),1:1)
+52 KILL LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
+53 SET LINK=$PIECE($GET(^PXRMD(801.41,DIEN,10,DGSUB,"LINK")),U)
IF LINK>0
DO GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
+54 SET DGIEN=$PIECE(DATA,U,2)
if 'DGIEN
QUIT
+55 ;Check if element is disabled/invalid
+56 IF $$ISDISAB(DGIEN)=1
QUIT
+57 SET DEXC=$PIECE(DATA,U,8)
+58 ;
+59 SET DATA=$GET(^PXRMD(801.41,DGIEN,0))
+60 SET DATANODE=$GET(^PXRMD(801.41,DGIEN,"DATA"))
+61 SET TNDATA=$PIECE(DATANODE,U,2)
+62 IF TNDATA=""
SET TNDATA=+NDATA
+63 ;S ODGIEN=DGIEN
+64 IF $DATA(^PXRMD(801.41,DGIEN,"BL"))
DO NREPLACE^PXRMDLLB(DFN,.DGIEN,.DATA,.BLFAIL,.BLTXT)
IF BLFAIL=1
QUIT
+65 ;I $G(BLINK)>0 D
+66 ;.K LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT S LINK=BLINK
+67 ;.D GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
+68 ;I ODGIEN=DGIEN,$G(LINK)="" D
+69 IF $GET(DGIEN)'>0
QUIT
+70 ;Exclude from P/N
+71 ;S DEXC=$P(DATA,U,8)
+72 IF $PIECE($GET(^PXRMD(801.41,DGIEN,0)),U,16)'["WHR"
Begin DoDot:2
+73 KILL DTXT
SET SUB=0
FOR
SET SUB=$ORDER(^PXRMD(801.41,DGIEN,25,SUB))
if 'SUB
QUIT
Begin DoDot:3
+74 SET DTXT(SUB)=$GET(^PXRMD(801.41,DGIEN,25,SUB,0))
End DoDot:3
+75 IF $DATA(BLTXT)>9
Begin DoDot:3
+76 NEW SUB1
+77 SET SUB=$ORDER(DTXT("?"),-1)
SET SUB1=0
FOR
SET SUB1=$ORDER(BLTXT(SUB1))
if 'SUB1
QUIT
Begin DoDot:4
+78 SET SUB=SUB+1
SET DTXT(SUB)=BLTXT(SUB1)
End DoDot:4
End DoDot:3
+79 KILL BLTXT
End DoDot:2
+80 ;S DATA=$G(^PXRMD(801.41,DGIEN,0))
+81 ;If the actual element is exclude from P/N override
+82 IF $PIECE($GET(^PXRMD(801.41,DGIEN,2)),U,3)
SET DEXC=1
+83 SET DTYP=$PIECE(DATA,U,4)
SET DSUPP=$PIECE(DATA,U,11)
if "EG"'[DTYP
QUIT
+84 SET DMHEX=$PIECE(DATA,U,14)
+85 SET DRESL=$$RESGROUP^PXRMDLLB(DGIEN)
+86 ;S DRESL=$P(DATA,U,15)
+87 SET DRES=$PIECE($GET(^PXRMD(801.41,DGIEN,1)),U,3)
+88 ;Done Elsewhere (historical)
+89 SET DHIS=$$AHIS(DGIEN)
+90 SET DFIND=$PIECE($GET(^PXRMD(801.41,DGIEN,1)),U,5)
+91 SET DFIEN=$PIECE(DFIND,";")
SET DFTYP=$PIECE(DFIND,";",2)
+92 SET DPCE=""
IF DFTYP'=""
SET DPCE=$GET(DARRAY(DFTYP))
+93 ;If mental Health ignore if not GUI
+94 IF DPCE="MH"
if '$$OK(DFIEN)
QUIT
+95 ;S DGRP=DSUB_"."_DGSUB
+96 SET DGRP=$SELECT(ISNEWSTR:DSUB_"."_DGSEQ,1:DSUB_"."_DGSUB)
+97 ;Taxonomy codes need expanding
+98 IF DPCE="T"
IF DTYP'="G"
DO EXP(DFIEN,DGIEN,DGRP,DEXC,DMHEX,DRESL,.DTXT,$GET(LINKITEM),$GET(LINKTYPE),$GET(LINKFUNC),$GET(LINKACT),TNDATA,DATANODE)
QUIT
+99 ;Translate vitals ien to PCE code - This will need a DBIA
+100 IF DPCE="VIT"
SET DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
+101 ;Embedded Dialog Group
+102 IF DTYP="G"
DO GROUP(DGIEN,DGRP,CHECK,DATA,$GET(LINKITEM),$GET(LINKTYPE),$GET(LINKFUNC),$GET(LINKACT),.BLFAIL,.TNDATA,.CHKSTAT)
QUIT
+103 SET DDIS="S"
IF DSUPP=1
SET DDIS="D"
+104 SET TDCHK=""
+105 IF DDIS="S"
IF CHECK=1
IF TNDATA'=1
IF $$DCHK^PXRMDLLC(DGIEN)="C"
SET TDCHK="C"
+106 IF DSUPP="C"!(TDCHK="C")
SET DDIS="C"
+107 SET DGRP=$SELECT(ISNEWSTR:DSUB_"."_DGSEQ,1:DSUB_"."_DGSUB)
SET OCNT=OCNT+1
+108 SET ORY(OCNT)=1_U_DGIEN_U_DGRP_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL_U_$GET(DCOUNT)
+109 IF +$GET(LINKITEM)>0
SET $PIECE(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$SELECT(LINKFUNC'>0:$PIECE(LINKACT,U),1:"")
+110 SET $PIECE(ORY(OCNT),U,25)=$$NEEDRPC(DGIEN)
+111 SET DATANODE=$GET(^PXRMD(801.41,DGIEN,"DATA"))
+112 SET $PIECE(ORY(OCNT),U,26)=$PIECE(DATANODE,U)
+113 SET $PIECE(ORY(OCNT),U,27)=+TNDATA
+114 SET $PIECE(ORY(OCNT),U,28)=$PIECE($GET(LINKACT),U,2)
+115 ;
+116 IF DDIS="C"!(TDCHK="C")
DO CHKHLVL^PXRMDLLC(.ORY,OCNT,.CHKSTAT)
+117 NEW LAST,TEXT
+118 SET SUB=0
SET LAST=0
FOR
SET SUB=$ORDER(DTXT(SUB))
if 'SUB
QUIT
Begin DoDot:2
+119 DO TXT
+120 SET OCNT=OCNT+1
SET ORY(OCNT)=2_U_DGIEN_U_DGRP_U_TEXT
End DoDot:2
End DoDot:1
+121 QUIT
+122 ;
ISDISAB(PXRMIEN) ;
+1 NEW CNT,PXRMDATA,ERRORTXT,HEADER,MSG,MSGCNT,RESULT,STDFILES,TYPE,ZTSAVE
+2 SET PXRMDATA=$GET(^PXRMD(801.41,PXRMIEN,0))
+3 IF +$PIECE(PXRMDATA,U,3)=0
QUIT 0
+4 IF +$PIECE(PXRMDATA,U,3)=2
QUIT 1
+5 SET HEADER="Disabled Dialog Item is being used in CPRS."
+6 SET TYPE=$PIECE(PXRMDATA,U,4)
+7 SET CNT=1
+8 SET TYPE=$SELECT(TYPE="E":"Element",TYPE="G":"Group",TYPE="R":"Result Group",1:"Item")
+9 SET ERRORTXT(CNT,0)="Reminder Dialog "_TYPE_" "_$PIECE(PXRMDATA,U)_" is inactive."
+10 DO DIALDSAR^PXRMFRPT(.STDFILES)
IF '$DATA(STDFILES)
GOTO ISDISABX
+11 SET RESULT=$$DISABCHK^PXRMDLG6(PXRMIEN,.STDFILES,.MSG)
+12 IF '$DATA(MSG)
GOTO ISDISABX
+13 SET CNT=CNT+1
SET ERRORTXT(CNT,0)=""
SET CNT=CNT+1
+14 SET MSGCNT=0
+15 FOR
SET MSGCNT=$ORDER(MSG(MSGCNT))
if MSGCNT'>0
QUIT
Begin DoDot:1
+16 SET CNT=CNT+1
+17 SET ERRORTXT(CNT,0)=" "_$GET(MSG(MSGCNT))
End DoDot:1
+18 ;
ISDISABX ;
+1 SET ZTSAVE("HEADER")=""
+2 SET ZTSAVE("ERRORTXT(")=""
+3 DO ERROR("Reminder Dialog disable check",.ZTSAVE)
+4 QUIT 1
+5 ;
ERROR(DESC,ZTSAVE) ;
+1 NEW ZTDESC,ZTDTH,ZTRTN,ZTIO
+2 SET ZTDESC=DESC
+3 SET ZTRTN="ERRORQ^PXRMDLL"
+4 SET ZTIO=""
+5 SET ZTDTH=$$NOW^XLFDT
+6 DO ^%ZTLOAD
+7 QUIT
ERRORQ ;
+1 MERGE ^TMP("PXRMXMZ",$JOB)=ERRORTXT
+2 DO SEND^PXRMMSG("PXRMXMZ",HEADER,"",DUZ)
+3 QUIT
+4 ;
LOAD(DIEN,DFN,VISITID) ;Load dialog questions into array
+1 NEW BLFAIL,DATANODE,DARRAY,DATA,DITEM,DFIND,DFIEN,DFTYP,DPCE,DRES,DSEQ,DSUB,DTXT,DTYP,OCNT
+2 NEW DDIS,DEXC,DHIDE,DCHECK,DDIS,DHIS,DMHEX,DRESL,DSUPP,SUB,IDENT,TXTCNT,REINDX
+3 NEW CHKLVL,DIALOGIEN,CHECK,TDCHK,CHKSTAT
+4 NEW LINKITEM,LINKTYPE,LINKFUNC,LINKACT,BLTXT,DATANODE,NDATA
+5 IF VISITID'=""
DO BLDVISIT^PXRMDLLC(VISITID)
+6 NEW ISNEWSTR
+7 ;CHKLVL Switch to turn on new editing functionality.
+8 SET CHKLVL=1
SET NDATA=""
+9 SET DIALOGIEN=DIEN
SET BLFAIL=0
+10 KILL ^TMP($JOB,"PXRM GEN FINDING",DIEN),^TMP($JOB,"PXRM DIALOG EVAL",DIALOGIEN)
+11 ;Check Status of dialog
+12 SET DATA=$GET(^PXRMD(801.41,DIEN,0))
if DATA=""
QUIT
+13 ;If disabled ignore
+14 IF $$ISDISAB(DIEN)=1
QUIT
+15 ;Ignore if not a reminder dialog
+16 IF $PIECE(DATA,U,4)'="R"
QUIT
+17 ;check for disable evaluation disable if it contains branching logic
+18 SET REINDX=0
+19 IF $DATA(^XTMP("PXRM_DISEV",0))
Begin DoDot:1
+20 SET ORY(1)=1_U_U_"1"_U_"D"_U_"1"_U_U_U_"0"_U_U
+21 SET ORY(2)=2_U_U_"1"_U_"Dialog is disable for reminder re-indexing"
+22 SET REINDX=1
End DoDot:1
+23 IF REINDX=1
QUIT
+24 ;List of PCE codes
+25 SET DARRAY("AUTTEDT(")="PED"
+26 SET DARRAY("AUTTEXAM(")="XAM"
+27 SET DARRAY("AUTTHF(")="HF"
+28 SET DARRAY("AUTTIMM(")="IMM"
+29 SET DARRAY("AUTTSK(")="SK"
+30 SET DARRAY("GMRD(120.51,")="VIT"
+31 SET DARRAY("ORD(101.41,")="Q"
+32 SET DARRAY("YTT(601.71,")="MH"
+33 ;AGP TODO before release ICD9 and CPT can be deleted
+34 SET DARRAY("ICD9(")="POV"
+35 SET DARRAY("ICPT(")="CPT"
+36 SET DARRAY("PXD(811.2,")="T"
+37 SET DARRAY("WV(790.1,")="WHR"
+38 SET DARRAY("PXRMD(801.46,")="GFIND"
+39 ;
+40 ;Get elements for the dialog
+41 SET DSEQ=0
SET OCNT=0
SET ISNEWSTR=0
+42 IF $PIECE(DATA,U,16)="UCS"
SET ISNEWSTR=1
+43 FOR
SET DSEQ=$ORDER(^PXRMD(801.41,DIEN,10,"B",DSEQ))
if 'DSEQ!(BLFAIL=1)
QUIT
Begin DoDot:1
+44 SET DSUB=$ORDER(^PXRMD(801.41,DIEN,10,"B",DSEQ,""))
if 'DSUB
QUIT
+45 SET DATA=$GET(^PXRMD(801.41,DIEN,10,DSUB,0))
+46 SET CHECK=$SELECT($PIECE(DATA,U,12)'="":$PIECE(DATA,U,12),1:1)
+47 SET DITEM=$PIECE(DATA,U,2)
if DITEM=""
QUIT
+48 ;Ignore disabled elements
+49 SET DATA=$GET(^PXRMD(801.41,DITEM,0))
if DATA=""
QUIT
if $$ISDISAB(DITEM)=1
QUIT
+50 SET DATANODE=$GET(^PXRMD(801.41,DITEM,"DATA"))
+51 SET NDATA=$SELECT(+$PIECE(DATANODE,U,2)=1:1,1:0)
+52 ;Branching logic
+53 IF $DATA(^PXRMD(801.41,DITEM,"BL"))
DO NREPLACE^PXRMDLLB(DFN,.DITEM,.DATA,.BLFAIL,.BLTXT)
IF BLFAIL=1
QUIT
+54 IF $GET(DITEM)'>0
QUIT
+55 SET DTYP=$PIECE(DATA,U,4)
SET DSUPP=$PIECE(DATA,U,11)
+56 SET DMHEX=$PIECE(DATA,U,14)
+57 SET DRESL=$$RESGROUP^PXRMDLLB(DITEM)
+58 ;S DRESL=$P(DATA,U,15)
+59 KILL DTXT
SET SUB=0
+60 IF '$DATA(DTXT)
Begin DoDot:2
+61 SET SUB=0
+62 FOR
SET SUB=$ORDER(^PXRMD(801.41,DITEM,25,SUB))
if 'SUB
QUIT
Begin DoDot:3
+63 SET DTXT(SUB)=$GET(^PXRMD(801.41,DITEM,25,SUB,0))
End DoDot:3
End DoDot:2
+64 IF $DATA(BLTXT)>9
Begin DoDot:2
+65 NEW SUB1
+66 SET SUB=$ORDER(DTXT("?"),-1)
SET SUB1=0
FOR
SET SUB1=$ORDER(BLTXT(SUB1))
if 'SUB1
QUIT
Begin DoDot:3
+67 SET SUB=SUB+1
SET DTXT(SUB)=BLTXT(SUB1)
End DoDot:3
+68 KILL BLTXT
End DoDot:2
+69 SET DRES=$PIECE($GET(^PXRMD(801.41,DITEM,1)),U,3)
+70 SET DFIND=$PIECE($GET(^PXRMD(801.41,DITEM,1)),U,5)
+71 SET DFIEN=$PIECE(DFIND,";")
SET DFTYP=$PIECE(DFIND,";",2)
+72 SET DPCE=""
IF DFTYP'=""
SET DPCE=$GET(DARRAY(DFTYP))
+73 KILL LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,RESULT
+74 ;I $G(BLINK)>0 S LINK=BLINK D GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
+75 SET LINK=$PIECE($GET(^PXRMD(801.41,DIEN,10,DSUB,"LINK")),U)
IF LINK>0
DO GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
+76 ;If mental Health ignore if not GUI
+77 IF DPCE="MH"
if '$$OK(DFIEN)
QUIT
+78 ;Exclude from PN
+79 SET DEXC=$PIECE($GET(^PXRMD(801.41,DITEM,2)),U,3)
+80 ;Done Elsewhere (historical)
+81 SET DHIS=$$AHIS(DITEM)
+82 ;Taxonomy codes need expanding
+83 IF DPCE="T"
IF DTYP'="G"
DO EXP(DFIEN,DITEM,$SELECT(ISNEWSTR:DSEQ,1:DSUB),DEXC,DMHEX,DRESL,.DTXT,$GET(LINKITEM),$GET(LINKTYPE),$GET(LINKFUNC),$GET(LINKACT),NDATA,DATANODE)
QUIT
+84 ;Translate vitals ien to PCE code - This will need a DBIA
+85 IF DPCE="VIT"
SET DFIEN=$PIECE($GET(^GMRD(120.51,DFIEN,0)),U,7)
+86 ;Dialog Group
+87 ;I DTYP="G" D GROUP(DITEM,DSUB,CHECK,DATA,$G(LINKITEM),$G(LINKTYPE),$G(LINKFUNC),$G(LINKACT),.BLFAIL,.NDATA,.CHKSTAT) Q
+88 IF DTYP="G"
DO GROUP(DITEM,$SELECT(ISNEWSTR:DSEQ,1:DSUB),CHECK,DATA,$GET(LINKITEM),$GET(LINKTYPE),$GET(LINKFUNC),$GET(LINKACT),.BLFAIL,.NDATA,.CHKSTAT)
QUIT
+89 ;Dialog type/text and resolution
+90 SET OCNT=OCNT+1
SET DDIS="S"
+91 IF DSUPP=1
SET DDIS="D"
+92 SET TDCHK=""
+93 IF DDIS="S"
IF CHECK=1
IF NDATA'=1
IF $$DCHK^PXRMDLLC(DIEN)="C"
SET TDCHK="C"
+94 IF DSUPP="C"!(TDCHK="C")
SET DDIS="C"
+95 SET ORY(OCNT)=1_U_DITEM_U_$SELECT(ISNEWSTR:DSEQ,1:DSUB)_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
+96 IF +$GET(LINKITEM)>0
SET $PIECE(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$SELECT(LINKFUNC'>0:$PIECE(LINKACT,U),1:"")
+97 SET $PIECE(ORY(OCNT),U,25)=$$NEEDRPC(DITEM)
+98 ;S DATANODE=$G(^PXRMD(801.41,DITEM,"DATA"))
+99 SET $PIECE(ORY(OCNT),U,26)=$PIECE(DATANODE,U)
+100 SET $PIECE(ORY(OCNT),U,27)=+NDATA
+101 SET $PIECE(ORY(OCNT),U,28)=$PIECE($GET(LINKACT),U,2)
+102 IF DDIS="C"!(TDCHK="C")
DO CHKHLVL^PXRMDLLC(.ORY,OCNT,.CHKSTAT)
+103 NEW LAST,TEXT
+104 SET SUB=0
SET LAST=0
FOR
SET SUB=$ORDER(DTXT(SUB))
if 'SUB
QUIT
Begin DoDot:2
+105 DO TXT
+106 SET OCNT=OCNT+1
SET ORY(OCNT)=2_U_DITEM_U_$SELECT(ISNEWSTR:DSEQ,1:DSUB)_U_TEXT
End DoDot:2
End DoDot:1
+107 KILL ^TMP($JOB,"PXRM DIALOG VISIT INFO")
+108 IF BLFAIL=1
Begin DoDot:1
+109 KILL OCNT,ORY
+110 SET ORY(1)=1_U_U_"1"_U_"D"_U_"1"_U_U_U_"0"_U_U
+111 SET ORY(2)=2_U_U_"1"_U_"Clinical Reminder evaluation error; this reminder dialog cannot be processed.<br>Please contact the reminder manager for assistance."
End DoDot:1
QUIT
+112 QUIT
+113 ;
TAX(TXIEN,DITEM,TEXT,ARRAY) ;Return list of resolutions/codes for taxonomy
+1 NEW CNT,DXNODE,DTXT,FAIL,HISTIEN,NODE,NUM,PRNODE,RESULT,RESVALUE,TCUR,TNAME,TSEL,TSCT,TYPE
+2 NEW TDTXT,TDHTXT,TPTXT,TPHTXT,TSCTXT
+3 ;
+4 ;Get taxonomy name
+5 ;S RESULT=0
+6 SET TNAME=$PIECE($GET(^PXD(811.2,TXIEN,0)),U,1)
+7 IF $PIECE($GET(^PXD(811.2,TXIEN,0)),U,6)=1
DO TAXERROR(DITEM,TXIEN)
QUIT
+8 ;
+9 SET TDX=$$TOK^PXRMDTAX(TXIEN,"POV")
+10 SET TPR=$$TOK^PXRMDTAX(TXIEN,"CPT")
+11 SET TSCT=$$TOK^PXRMDTAX(TXIEN,"SC")
+12 SET NODE=$GET(^PXRMD(801.41,DITEM,"TAX"))
+13 SET TSEL=$PIECE(NODE,U)
+14 DO TAXERROR(DITEM,TXIEN)
+15 ;
+16 SET DTXT=""
+17 ;Taxonomy dialog text
+18 IF DTXT=""
SET DTXT=$PIECE(NODE,U,4)
+19 ;default to taxonomy description if null
+20 IF DTXT=""
SET DTXT=$PIECE($GET(^PXD(811.2,TXIEN,0)),U,2)
+21 ;default to taxonomy name if null
+22 IF DTXT=""
SET DTXT=$PIECE($GET(^PXD(811.2,TXIEN,0)),U,1)
+23 ;
+24 SET CNT=0
SET ARRAY=DTXT
+25 ;
+26 ;make sure dialog is set to display diagnoses/procedure selection list
+27 IF TDX
SET TDX=$SELECT("AD"[TSEL:1,1:0)
+28 IF TPR
SET TPR=$SELECT("AP"[TSEL:1,1:0)
+29 IF TSCT
SET TSCT=$SELECT("AS"[TSEL:1,1:0)
+30 ;I TDX,TPR,TSCT S RESULT=1
+31 SET HISTIEN=$ORDER(^PXRMD(801.9,"B","DONE ELSEWHERE (HISTORICAL)",""))
+32 SET RESVALUE=$PIECE($GET(^PXRMD(801.41,DITEM,1)),U,3)
+33 SET TCUR=$SELECT(RESVALUE'=HISTIEN:1,1:0)
+34 ;Diagnoses
+35 IF TDX
Begin DoDot:1
+36 SET TDTXT=$PIECE($GET(^PXRMD(801.41,DITEM,"POV")),U)
if TDTXT=""
SET TDTXT=TNAME_$SELECT(TCUR=1:"",1:" (HISTORICAL)")
+37 SET CNT=CNT+1
SET ARRAY(CNT)=TDTXT_U_80_U_$SELECT(TCUR=1:1,1:2)_U_"POV"
End DoDot:1
+38 ;Procedures
+39 IF TPR
Begin DoDot:1
+40 SET TPTXT=$PIECE($GET(^PXRMD(801.41,DITEM,"CPT")),U)
if TPTXT=""
SET TPTXT=TNAME_$SELECT(TCUR=1:"",1:" (HISTORICAL)")
+41 SET CNT=CNT+1
SET ARRAY(CNT)=TPTXT_U_81_U_$SELECT(TCUR=1:1,1:2)_U_"CPT"
End DoDot:1
+42 IF TSCT
Begin DoDot:1
+43 SET TSCTXT="SNOMED SECTION"
if TSCTXT=""
SET TSCTXT=TNAME_$SELECT(TCUR=1:"",1:" (HISTORICAL)")
+44 SET CNT=CNT+1
SET ARRAY(CNT)=TSCTXT_U_750.1_U_$SELECT(TCUR=1:1,1:2)_U_"SC"
End DoDot:1
+45 ;
+46 QUIT
+47 ;
TAXERROR(DIEN,TIEN) ;
+1 NEW CNT,DNAME,ERRORTXT,FAIL,HEADER,LINE,NIN,NOUT,OUTPUT,TEMP,TNAME
+2 SET DNAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
if DNAME=""
QUIT
+3 SET TNAME=$PIECE($GET(^PXD(811.2,TIEN,0)),U)
+4 SET HEADER="Problem with dialog in CPRS"
+5 SET FAIL=$$CHECKER^PXRMDTAX(DIEN,TIEN,15,.OUTPUT)
IF FAIL=""
QUIT
+6 SET NIN=$ORDER(OUTPUT(""),-1)
+7 DO FORMAT^PXRMTEXT(1,75,NIN,.OUTPUT,.NOUT,.TEMP)
+8 SET CNT=0
FOR LINE=1:1:NOUT
SET CNT=CNT+1
SET ERRORTXT(CNT,0)=TEMP(LINE)
+9 SET CNT=CNT+1
SET ERRORTXT(CNT,0)="Please review and correct either the taxonomy or the dialog."
+10 SET ZTSAVE("HEADER")=""
SET ZTSAVE("ERRORTXT(")=""
+11 DO ERROR("Reminder Dialog/Taxonomy Loader check",.ZTSAVE)
+12 QUIT
+13 ;
AHIS(DITEM) ;
+1 NEW RSIEN,RSNAM
+2 SET RSIEN=$PIECE($GET(^PXRMD(801.41,DITEM,1)),U,3)
+3 IF RSIEN=""
QUIT 0
+4 SET RSNAM=$PIECE($GET(^PXRMD(801.9,RSIEN,0)),U)
+5 IF RSNAM["DONE ELSEWHERE"
QUIT 1
+6 IF RSNAM="CONTRAINDICATED"
QUIT 2
+7 IF RSNAM["REFUSED"
QUIT 3
+8 NEW GUI,PIEN,PFOUND
+9 SET PIEN=0
SET PFOUND=0
+10 FOR
SET PIEN=$ORDER(^PXRMD(801.41,DITEM,10,"D",PIEN))
if 'PIEN
QUIT
Begin DoDot:1
+11 ;Ignore elements and groups
+12 IF "EG"[$PIECE($GET(^PXRMD(801.41,PIEN,0)),U,4)
QUIT
+13 ;GUI Process
+14 SET GUI=$PIECE($GET(^PXRMD(801.41,PIEN,46)),U)
if 'GUI
QUIT
+15 ;Check if this is PXRM VISIT DATE (or a copy of it)
+16 IF $PIECE($GET(^PXRMD(801.42,GUI,0)),U)="VST_DATE"
SET PFOUND=1
End DoDot:1
if PFOUND
QUIT
+17 QUIT PFOUND
+18 ;
