Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMDLL

PXRMDLL.m

Go to the documentation of this file.
PXRMDLL ;SLC/PJH - REMINDER DIALOG LOADER ;1/31/2020
 ;;2.0;CLINICAL REMINDERS;**10,6,12,17,18,26,47,45**;Feb 04, 2005;Build 566
 ;
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,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(ARRAY) Q
 S DHIS=$$AHIS(DITEM)
 ;
 ;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
 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
 ;
 ;Taxonomy CPT/POV resolution prompts
 S ACNT=""
 F  S ACNT=$O(ARRAY(ACNT)) Q:ACNT=""  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
 .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
 .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
 ;
 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) ;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
 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
 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,TYPE
 N TDTXT,TDHTXT,TPTXT,TPHTXT
 ;
 ;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 RESULT
 ;
 S TDX=$$TOK^PXRMDTAX(TXIEN,"POV")
 S TPR=$$TOK^PXRMDTAX(TXIEN,"CPT")
 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 TDX,TPR 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"
 ;
 Q RESULT
 ;
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
 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
 ;