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.
  1. 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
  1. ;
  1. ; ICR API/FILE
  1. ; 3112 ^GMRD(120.51,
  1. ;
  1. NEEDRPC(DITEM) ;
  1. I $P($G(^PXRMD(801.41,DITEM,1)),U,5)'="" Q 1
  1. I $D(^PXRMD(801.41,DITEM,3,"B"))>1 Q 1
  1. I $D(^PXRMD(801.41,DITEM,10,"TYPE","P")) Q 1
  1. I $D(^PXRMD(801.41,DITEM,10,"TYPE","F")) Q 1
  1. I $D(^PXRMD(801.41,DITEM,35))>9 Q 1
  1. Q 0
  1. ;
  1. OK(DIEN) ;Check if mental health test is for GUI
  1. I 'DIEN Q 0
  1. Q $$MH^PXRMDLG5(DIEN)
  1. ;
  1. TXT ;Format text
  1. N NULL
  1. S TEXT=DTXT(SUB),NULL=0
  1. I ($E(TEXT)=" ")!(TEXT="") S NULL=1
  1. I LAST,'NULL S TEXT="<br>"_TEXT
  1. S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
  1. S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
  1. Q
  1. ;
  1. EXP(TIEN,DITEM,DSUB,DEXC,DMHEX,DRESL,DTXT,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,NDATA,DATANODE) ;Expand taxonomy codes
  1. N ACNT,AHIS,ATYP,ARRAY,BOTH,CODES,CNT,COUNT,DDIS,DHIST,DPCE,DSUPP,DTAX,SUB,TAXTEXT,TEXT,TSEL
  1. S TSEL=$P($G(^PXRMD(801.41,DITEM,"TAX")),U)
  1. S DSUPP=$P($G(^PXRMD(801.41,DITEM,0)),U,11)
  1. S DDIS=$S(DSUPP=1:"D",1:"S")
  1. ;
  1. S TEXT=""
  1. ;Get taxonomy file details
  1. ;I TSEL'="N" S BOTH=$$TAX(TIEN,DITEM,TEXT,.ARRAY)
  1. I TSEL'="N" D TAX(TIEN,DITEM,TEXT,.ARRAY)
  1. I TSEL'="N",'$D(ARRAY) Q
  1. S DHIS=$$AHIS(DITEM)
  1. S COUNT=$S('$D(ARRAY):0,1:$O(ARRAY(""),-1))
  1. ;
  1. ;Build dialog from the returned array
  1. ;
  1. S OCNT=OCNT+1
  1. ;this is new for Taxonomy selection types of N
  1. I TSEL="N" D Q
  1. .N LAST,TEXT
  1. .S ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
  1. .D SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT)
  1. .D SETNDATA(DATANODE,NDATA)
  1. .S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
  1. ..D TXT
  1. ..S OCNT=OCNT+1,ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
  1. ;Main Taxonomy prompt
  1. ;Default group indents and selection entry
  1. ;S TAXTEXT=ARRAY
  1. ;S ORY(OCNT)=1_U_DITEM_U_DSUB_U_"S"_U_DEXC
  1. S ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC
  1. ;S $P(ORY(OCNT),U,16)=2,$P(ORY(OCNT),U,18)=$S(BOTH=1:2,1:0),$P(ORY(OCNT),U,8)=DHIS
  1. S $P(ORY(OCNT),U,16)=2,$P(ORY(OCNT),U,18)=$S(COUNT>1:2,1:0),$P(ORY(OCNT),U,8)=DHIS
  1. D SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT)
  1. D SETNDATA(DATANODE,NDATA)
  1. N LAST,TEXT
  1. S TEXT=""
  1. S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
  1. .D TXT
  1. .S OCNT=OCNT+1
  1. .S ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
  1. ;
  1. I COUNT<2 Q
  1. ;Taxonomy CPT/POV resolution prompts
  1. S ACNT=0
  1. F S ACNT=$O(ARRAY(ACNT)) Q:ACNT'>0 D
  1. .;Prompt text
  1. .S TAXTEXT=$P(ARRAY(ACNT),U),DPCE=$P(ARRAY(ACNT),U,4)
  1. .;Historical/Current flag
  1. .S AHIS=0 I $P(ARRAY(ACNT),U,3)=2 S AHIS=1
  1. .;CPT/POV/SC
  1. .S ATYP=$S($P(ARRAY(ACNT),U,2)=80:"POV",$P(ARRAY(ACNT),U,2)=81:"CPT",1:"SC")
  1. .;S ATYP="POV" I $P(ARRAY(ACNT),U,2)=81 S ATYP="CPT"
  1. .;Initial display
  1. .;S DHIDE=0,DCHECK=0,DDIS=0
  1. .;Construct ien for this level
  1. .S DTAX=DSUB_"."_ACNT
  1. .;I BOTH=0 Q
  1. .;I COUNT<2 Q
  1. .S DEXC=1
  1. .S OCNT=OCNT+1
  1. .S ORY(OCNT)=1_U_DITEM_U_DTAX_U_"T"_U_DEXC_U_U_ATYP_U_AHIS
  1. .D SETLINK(LINKITEM,LINKTYPE,LINKFUNC,LINKACT)
  1. .D SETNDATA(DATANODE,NDATA)
  1. .S OCNT=OCNT+1
  1. .S ORY(OCNT)=2_U_DITEM_U_DTAX_U_TAXTEXT
  1. Q
  1. ;
  1. I +$G(LINKITEM)>0 S $P(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$S(LINKFUNC'>0:$P(LINKACT,U),1:"")
  1. S $P(ORY(OCNT),U,28)=$P($G(LINKACT),U,2)
  1. Q
  1. ;
  1. SETNDATA(DATANODE,NDATA) ;
  1. S $P(ORY(OCNT),U,26)=$P(DATANODE,U)
  1. S $P(ORY(OCNT),U,27)=+NDATA
  1. Q
  1. ;
  1. GROUP(DIEN,DSUB,CHECK,DATA,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,BLFAIL,NDATA,CHKSTAT) ;Dialog group
  1. N DATANODE,DBOX,DCAP,DCHK,DENTRY,DEXC,DCCNT,DGIEN,DGRP,DGSEQ,DGSUB,DHIDE,DIND
  1. N DINDPN,DMHEX,DRESL,DSHARE,SUB,DCOUNT,NOBL,ODATA,ODGIEN,DATANODE,TNDATA,TDCHK
  1. N DSUPP
  1. ;N BLTXT,LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,RESULT
  1. ;Group caption text
  1. I $G(DATA)="" S DATA=$G(^PXRMD(801.41,DIEN,0))
  1. S DCAP=$P(DATA,U,5),DBOX=$P(DATA,U,6),DIND=$P(DATA,U,7)
  1. S DSHARE=$P(DATA,U,8),DENTRY=$P(DATA,U,9),DHIDE=$P(DATA,U,10)
  1. S DINDPN=$P(DATA,U,12) S:DINDPN="" DINDPN=0
  1. S DBOX=$S(DBOX="Y":1,1:"")
  1. ;group header is display only if SUPPRESS CHECKBOX
  1. S TDCHK=""
  1. S DSUPP=$P(DATA,U,11),DCHK="S" I ('DHIDE)&(DSUPP) S DCHK="D",DHIDE=0
  1. I DCHK="S",CHECK=1,NDATA'=1,$$DCHK^PXRMDLLC(DIEN)="C" S TDCHK="C"
  1. I TDCHK="C"!(DSUPP="C") S DCHK="C"
  1. ;Default group setting to hide
  1. I DHIDE="" S DHIDE=1
  1. ;
  1. S DEXC=$P($G(^PXRMD(801.41,DIEN,2)),U,3)
  1. S DRESL=$$RESGROUP^PXRMDLLB(DIEN)
  1. ;
  1. S OCNT=OCNT+1,ORY(OCNT)=1_U_DIEN_U_DSUB_U_DCHK_U_DEXC
  1. S CHKSTAT(DSUB)=DIEN_U_CHECK
  1. S $P(ORY(OCNT),U,25)=$$NEEDRPC(DIEN)
  1. I DRESL'="" S $P(ORY(OCNT),U,10)=DRESL K DRESL
  1. S $P(ORY(OCNT),U,8)=$$AHIS(DIEN)
  1. S $P(ORY(OCNT),U,15)=DHIDE,$P(ORY(OCNT),U,16)=DIND
  1. S $P(ORY(OCNT),U,17)=DSHARE,$P(ORY(OCNT),U,18)=DENTRY
  1. S $P(ORY(OCNT),U,19)=DBOX,$P(ORY(OCNT),U,20)=DCAP
  1. S $P(ORY(OCNT),U,21)=DINDPN
  1. I +$G(LINKITEM)>0 S $P(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$S(LINKFUNC'>0:$P(LINKACT,U),1:"")
  1. S $P(ORY(OCNT),U,25)=$$NEEDRPC(DIEN)
  1. S DATANODE=$G(^PXRMD(801.41,DIEN,"DATA"))
  1. S $P(ORY(OCNT),U,26)=$P(DATANODE,U)
  1. S $P(ORY(OCNT),U,27)=+NDATA
  1. S $P(ORY(OCNT),U,28)=$P(LINKACT,U,2)
  1. I DCHK="C"!(TDCHK="C") D CHKHLVL^PXRMDLLC(.ORY,OCNT,.CHKSTAT) K DCHK
  1. ;Create type 2 records if if here is additional group text
  1. N LAST,TEXT
  1. S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
  1. .D TXT
  1. .S OCNT=OCNT+1,ORY(OCNT)=2_U_DIEN_U_DSUB_U_TEXT
  1. ;Get dialog group sub-elements
  1. ;Linking variables
  1. N BLTXT,LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
  1. N DGCNT,DTYP,DSUPP,DDIS,IDENT S DGSEQ=0,DGCNT=0
  1. F S DGSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ)) Q:'DGSEQ!(BLFAIL=1) D
  1. .S DGSUB=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ,"")) Q:'DGSUB
  1. .S DGCNT=DGCNT+1
  1. .S DATA=$G(^PXRMD(801.41,DIEN,10,DGSUB,0))
  1. .S CHECK=$S($P(DATA,U,12)'="":$P(DATA,U,12),1:1)
  1. .K LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
  1. .S LINK=$P($G(^PXRMD(801.41,DIEN,10,DGSUB,"LINK")),U) I LINK>0 D GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
  1. .S DGIEN=$P(DATA,U,2) Q:'DGIEN
  1. .;Check if element is disabled/invalid
  1. .I $$ISDISAB(DGIEN)=1 Q
  1. .S DEXC=$P(DATA,U,8)
  1. .;
  1. .S DATA=$G(^PXRMD(801.41,DGIEN,0))
  1. .S DATANODE=$G(^PXRMD(801.41,DGIEN,"DATA"))
  1. .S TNDATA=$P(DATANODE,U,2)
  1. .I TNDATA="" S TNDATA=+NDATA
  1. .;S ODGIEN=DGIEN
  1. .I $D(^PXRMD(801.41,DGIEN,"BL")) D NREPLACE^PXRMDLLB(DFN,.DGIEN,.DATA,.BLFAIL,.BLTXT) I BLFAIL=1 Q
  1. .;I $G(BLINK)>0 D
  1. .;.K LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT S LINK=BLINK
  1. .;.D GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
  1. .;I ODGIEN=DGIEN,$G(LINK)="" D
  1. .I $G(DGIEN)'>0 Q
  1. .;Exclude from P/N
  1. .;S DEXC=$P(DATA,U,8)
  1. .I $P($G(^PXRMD(801.41,DGIEN,0)),U,16)'["WHR" D
  1. ..K DTXT S SUB=0 F S SUB=$O(^PXRMD(801.41,DGIEN,25,SUB)) Q:'SUB D
  1. ...S DTXT(SUB)=$G(^PXRMD(801.41,DGIEN,25,SUB,0))
  1. ..I $D(BLTXT)>9 D
  1. ...N SUB1
  1. ...S SUB=$O(DTXT("?"),-1),SUB1=0 F S SUB1=$O(BLTXT(SUB1)) Q:'SUB1 D
  1. ....S SUB=SUB+1,DTXT(SUB)=BLTXT(SUB1)
  1. ..K BLTXT
  1. .;S DATA=$G(^PXRMD(801.41,DGIEN,0))
  1. .;If the actual element is exclude from P/N override
  1. .I $P($G(^PXRMD(801.41,DGIEN,2)),U,3) S DEXC=1
  1. .S DTYP=$P(DATA,U,4),DSUPP=$P(DATA,U,11) Q:"EG"'[DTYP
  1. .S DMHEX=$P(DATA,U,14)
  1. .S DRESL=$$RESGROUP^PXRMDLLB(DGIEN)
  1. .;S DRESL=$P(DATA,U,15)
  1. .S DRES=$P($G(^PXRMD(801.41,DGIEN,1)),U,3)
  1. .;Done Elsewhere (historical)
  1. .S DHIS=$$AHIS(DGIEN)
  1. .S DFIND=$P($G(^PXRMD(801.41,DGIEN,1)),U,5)
  1. .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
  1. .S DPCE="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
  1. .;If mental Health ignore if not GUI
  1. .I DPCE="MH" Q:'$$OK(DFIEN)
  1. .;S DGRP=DSUB_"."_DGSUB
  1. .S DGRP=$S(ISNEWSTR:DSUB_"."_DGSEQ,1:DSUB_"."_DGSUB)
  1. .;Taxonomy codes need expanding
  1. .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
  1. .;Translate vitals ien to PCE code - This will need a DBIA
  1. .I DPCE="VIT" S DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
  1. .;Embedded Dialog Group
  1. .I DTYP="G" D GROUP(DGIEN,DGRP,CHECK,DATA,$G(LINKITEM),$G(LINKTYPE),$G(LINKFUNC),$G(LINKACT),.BLFAIL,.TNDATA,.CHKSTAT) Q
  1. .S DDIS="S" I DSUPP=1 S DDIS="D"
  1. .S TDCHK=""
  1. .I DDIS="S",CHECK=1,TNDATA'=1,$$DCHK^PXRMDLLC(DGIEN)="C" S TDCHK="C"
  1. .I DSUPP="C"!(TDCHK="C") S DDIS="C"
  1. .S DGRP=$S(ISNEWSTR:DSUB_"."_DGSEQ,1:DSUB_"."_DGSUB),OCNT=OCNT+1
  1. .S ORY(OCNT)=1_U_DGIEN_U_DGRP_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL_U_$G(DCOUNT)
  1. .I +$G(LINKITEM)>0 S $P(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$S(LINKFUNC'>0:$P(LINKACT,U),1:"")
  1. .S $P(ORY(OCNT),U,25)=$$NEEDRPC(DGIEN)
  1. .S DATANODE=$G(^PXRMD(801.41,DGIEN,"DATA"))
  1. .S $P(ORY(OCNT),U,26)=$P(DATANODE,U)
  1. .S $P(ORY(OCNT),U,27)=+TNDATA
  1. .S $P(ORY(OCNT),U,28)=$P($G(LINKACT),U,2)
  1. .;
  1. .I DDIS="C"!(TDCHK="C") D CHKHLVL^PXRMDLLC(.ORY,OCNT,.CHKSTAT)
  1. .N LAST,TEXT
  1. .S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
  1. ..D TXT
  1. ..S OCNT=OCNT+1,ORY(OCNT)=2_U_DGIEN_U_DGRP_U_TEXT
  1. Q
  1. ;
  1. ISDISAB(PXRMIEN) ;
  1. N CNT,PXRMDATA,ERRORTXT,HEADER,MSG,MSGCNT,RESULT,STDFILES,TYPE,ZTSAVE
  1. S PXRMDATA=$G(^PXRMD(801.41,PXRMIEN,0))
  1. I +$P(PXRMDATA,U,3)=0 Q 0
  1. I +$P(PXRMDATA,U,3)=2 Q 1
  1. S HEADER="Disabled Dialog Item is being used in CPRS."
  1. S TYPE=$P(PXRMDATA,U,4)
  1. S CNT=1
  1. S TYPE=$S(TYPE="E":"Element",TYPE="G":"Group",TYPE="R":"Result Group",1:"Item")
  1. S ERRORTXT(CNT,0)="Reminder Dialog "_TYPE_" "_$P(PXRMDATA,U)_" is inactive."
  1. D DIALDSAR^PXRMFRPT(.STDFILES) I '$D(STDFILES) G ISDISABX
  1. S RESULT=$$DISABCHK^PXRMDLG6(PXRMIEN,.STDFILES,.MSG)
  1. I '$D(MSG) G ISDISABX
  1. S CNT=CNT+1,ERRORTXT(CNT,0)="",CNT=CNT+1
  1. S MSGCNT=0
  1. F S MSGCNT=$O(MSG(MSGCNT)) Q:MSGCNT'>0 D
  1. .S CNT=CNT+1
  1. .S ERRORTXT(CNT,0)=" "_$G(MSG(MSGCNT))
  1. ;
  1. ISDISABX ;
  1. S ZTSAVE("HEADER")=""
  1. S ZTSAVE("ERRORTXT(")=""
  1. D ERROR("Reminder Dialog disable check",.ZTSAVE)
  1. Q 1
  1. ;
  1. ERROR(DESC,ZTSAVE) ;
  1. N ZTDESC,ZTDTH,ZTRTN,ZTIO
  1. S ZTDESC=DESC
  1. S ZTRTN="ERRORQ^PXRMDLL"
  1. S ZTIO=""
  1. S ZTDTH=$$NOW^XLFDT
  1. D ^%ZTLOAD
  1. Q
  1. ERRORQ ;
  1. M ^TMP("PXRMXMZ",$J)=ERRORTXT
  1. D SEND^PXRMMSG("PXRMXMZ",HEADER,"",DUZ)
  1. Q
  1. ;
  1. LOAD(DIEN,DFN,VISITID) ;Load dialog questions into array
  1. N BLFAIL,DATANODE,DARRAY,DATA,DITEM,DFIND,DFIEN,DFTYP,DPCE,DRES,DSEQ,DSUB,DTXT,DTYP,OCNT
  1. N DDIS,DEXC,DHIDE,DCHECK,DDIS,DHIS,DMHEX,DRESL,DSUPP,SUB,IDENT,TXTCNT,REINDX
  1. N CHKLVL,DIALOGIEN,CHECK,TDCHK,CHKSTAT
  1. N LINKITEM,LINKTYPE,LINKFUNC,LINKACT,BLTXT,DATANODE,NDATA
  1. I VISITID'="" D BLDVISIT^PXRMDLLC(VISITID)
  1. N ISNEWSTR
  1. ;CHKLVL Switch to turn on new editing functionality.
  1. S CHKLVL=1,NDATA=""
  1. S DIALOGIEN=DIEN,BLFAIL=0
  1. K ^TMP($J,"PXRM GEN FINDING",DIEN),^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN)
  1. ;Check Status of dialog
  1. S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA=""
  1. ;If disabled ignore
  1. I $$ISDISAB(DIEN)=1 Q
  1. ;Ignore if not a reminder dialog
  1. I $P(DATA,U,4)'="R" Q
  1. ;check for disable evaluation disable if it contains branching logic
  1. S REINDX=0
  1. I $D(^XTMP("PXRM_DISEV",0)) D
  1. .S ORY(1)=1_U_U_"1"_U_"D"_U_"1"_U_U_U_"0"_U_U
  1. .S ORY(2)=2_U_U_"1"_U_"Dialog is disable for reminder re-indexing"
  1. .S REINDX=1
  1. I REINDX=1 Q
  1. ;List of PCE codes
  1. S DARRAY("AUTTEDT(")="PED"
  1. S DARRAY("AUTTEXAM(")="XAM"
  1. S DARRAY("AUTTHF(")="HF"
  1. S DARRAY("AUTTIMM(")="IMM"
  1. S DARRAY("AUTTSK(")="SK"
  1. S DARRAY("GMRD(120.51,")="VIT"
  1. S DARRAY("ORD(101.41,")="Q"
  1. S DARRAY("YTT(601.71,")="MH"
  1. ;AGP TODO before release ICD9 and CPT can be deleted
  1. S DARRAY("ICD9(")="POV"
  1. S DARRAY("ICPT(")="CPT"
  1. S DARRAY("PXD(811.2,")="T"
  1. S DARRAY("WV(790.1,")="WHR"
  1. S DARRAY("PXRMD(801.46,")="GFIND"
  1. ;
  1. ;Get elements for the dialog
  1. S DSEQ=0,OCNT=0,ISNEWSTR=0
  1. I $P(DATA,U,16)="UCS" S ISNEWSTR=1
  1. F S DSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ)) Q:'DSEQ!(BLFAIL=1) D
  1. .S DSUB=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ,"")) Q:'DSUB
  1. .S DATA=$G(^PXRMD(801.41,DIEN,10,DSUB,0))
  1. .S CHECK=$S($P(DATA,U,12)'="":$P(DATA,U,12),1:1)
  1. .S DITEM=$P(DATA,U,2) Q:DITEM=""
  1. .;Ignore disabled elements
  1. .S DATA=$G(^PXRMD(801.41,DITEM,0)) Q:DATA="" Q:$$ISDISAB(DITEM)=1
  1. .S DATANODE=$G(^PXRMD(801.41,DITEM,"DATA"))
  1. .S NDATA=$S(+$P(DATANODE,U,2)=1:1,1:0)
  1. .;Branching logic
  1. .I $D(^PXRMD(801.41,DITEM,"BL")) D NREPLACE^PXRMDLLB(DFN,.DITEM,.DATA,.BLFAIL,.BLTXT) I BLFAIL=1 Q
  1. .I $G(DITEM)'>0 Q
  1. .S DTYP=$P(DATA,U,4),DSUPP=$P(DATA,U,11)
  1. .S DMHEX=$P(DATA,U,14)
  1. .S DRESL=$$RESGROUP^PXRMDLLB(DITEM)
  1. .;S DRESL=$P(DATA,U,15)
  1. .K DTXT S SUB=0
  1. .I '$D(DTXT) D
  1. ..S SUB=0
  1. ..F S SUB=$O(^PXRMD(801.41,DITEM,25,SUB)) Q:'SUB D
  1. ...S DTXT(SUB)=$G(^PXRMD(801.41,DITEM,25,SUB,0))
  1. .I $D(BLTXT)>9 D
  1. ..N SUB1
  1. ..S SUB=$O(DTXT("?"),-1),SUB1=0 F S SUB1=$O(BLTXT(SUB1)) Q:'SUB1 D
  1. ...S SUB=SUB+1,DTXT(SUB)=BLTXT(SUB1)
  1. ..K BLTXT
  1. .S DRES=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
  1. .S DFIND=$P($G(^PXRMD(801.41,DITEM,1)),U,5)
  1. .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
  1. .S DPCE="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
  1. .K LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT,RESULT
  1. .;I $G(BLINK)>0 S LINK=BLINK D GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
  1. .S LINK=$P($G(^PXRMD(801.41,DIEN,10,DSUB,"LINK")),U) I LINK>0 D GETLINK^PXRMDLLB(LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
  1. .;If mental Health ignore if not GUI
  1. .I DPCE="MH" Q:'$$OK(DFIEN)
  1. .;Exclude from PN
  1. .S DEXC=$P($G(^PXRMD(801.41,DITEM,2)),U,3)
  1. .;Done Elsewhere (historical)
  1. .S DHIS=$$AHIS(DITEM)
  1. .;Taxonomy codes need expanding
  1. .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
  1. .;Translate vitals ien to PCE code - This will need a DBIA
  1. .I DPCE="VIT" S DFIEN=$P($G(^GMRD(120.51,DFIEN,0)),U,7)
  1. .;Dialog Group
  1. .;I DTYP="G" D GROUP(DITEM,DSUB,CHECK,DATA,$G(LINKITEM),$G(LINKTYPE),$G(LINKFUNC),$G(LINKACT),.BLFAIL,.NDATA,.CHKSTAT) Q
  1. .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
  1. .;Dialog type/text and resolution
  1. .S OCNT=OCNT+1,DDIS="S"
  1. .I DSUPP=1 S DDIS="D"
  1. .S TDCHK=""
  1. .I DDIS="S",CHECK=1,NDATA'=1,$$DCHK^PXRMDLLC(DIEN)="C" S TDCHK="C"
  1. .I DSUPP="C"!(TDCHK="C") S DDIS="C"
  1. .S ORY(OCNT)=1_U_DITEM_U_$S(ISNEWSTR:DSEQ,1:DSUB)_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
  1. .I +$G(LINKITEM)>0 S $P(ORY(OCNT),U,22)=LINKITEM_U_LINKTYPE_U_$S(LINKFUNC'>0:$P(LINKACT,U),1:"")
  1. .S $P(ORY(OCNT),U,25)=$$NEEDRPC(DITEM)
  1. .;S DATANODE=$G(^PXRMD(801.41,DITEM,"DATA"))
  1. .S $P(ORY(OCNT),U,26)=$P(DATANODE,U)
  1. .S $P(ORY(OCNT),U,27)=+NDATA
  1. .S $P(ORY(OCNT),U,28)=$P($G(LINKACT),U,2)
  1. .I DDIS="C"!(TDCHK="C") D CHKHLVL^PXRMDLLC(.ORY,OCNT,.CHKSTAT)
  1. .N LAST,TEXT
  1. .S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
  1. ..D TXT
  1. ..S OCNT=OCNT+1,ORY(OCNT)=2_U_DITEM_U_$S(ISNEWSTR:DSEQ,1:DSUB)_U_TEXT
  1. K ^TMP($J,"PXRM DIALOG VISIT INFO")
  1. I BLFAIL=1 D Q
  1. .K OCNT,ORY
  1. .S ORY(1)=1_U_U_"1"_U_"D"_U_"1"_U_U_U_"0"_U_U
  1. .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."
  1. Q
  1. ;
  1. TAX(TXIEN,DITEM,TEXT,ARRAY) ;Return list of resolutions/codes for taxonomy
  1. N CNT,DXNODE,DTXT,FAIL,HISTIEN,NODE,NUM,PRNODE,RESULT,RESVALUE,TCUR,TNAME,TSEL,TSCT,TYPE
  1. N TDTXT,TDHTXT,TPTXT,TPHTXT,TSCTXT
  1. ;
  1. ;Get taxonomy name
  1. ;S RESULT=0
  1. S TNAME=$P($G(^PXD(811.2,TXIEN,0)),U,1)
  1. I $P($G(^PXD(811.2,TXIEN,0)),U,6)=1 D TAXERROR(DITEM,TXIEN) Q
  1. ;
  1. S TDX=$$TOK^PXRMDTAX(TXIEN,"POV")
  1. S TPR=$$TOK^PXRMDTAX(TXIEN,"CPT")
  1. S TSCT=$$TOK^PXRMDTAX(TXIEN,"SC")
  1. S NODE=$G(^PXRMD(801.41,DITEM,"TAX"))
  1. S TSEL=$P(NODE,U)
  1. D TAXERROR(DITEM,TXIEN)
  1. ;
  1. S DTXT=""
  1. ;Taxonomy dialog text
  1. I DTXT="" S DTXT=$P(NODE,U,4)
  1. ;default to taxonomy description if null
  1. I DTXT="" S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,2)
  1. ;default to taxonomy name if null
  1. I DTXT="" S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,1)
  1. ;
  1. S CNT=0,ARRAY=DTXT
  1. ;
  1. ;make sure dialog is set to display diagnoses/procedure selection list
  1. I TDX S TDX=$S("AD"[TSEL:1,1:0)
  1. I TPR S TPR=$S("AP"[TSEL:1,1:0)
  1. I TSCT S TSCT=$S("AS"[TSEL:1,1:0)
  1. ;I TDX,TPR,TSCT S RESULT=1
  1. S HISTIEN=$O(^PXRMD(801.9,"B","DONE ELSEWHERE (HISTORICAL)",""))
  1. S RESVALUE=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
  1. S TCUR=$S(RESVALUE'=HISTIEN:1,1:0)
  1. ;Diagnoses
  1. I TDX D
  1. .S TDTXT=$P($G(^PXRMD(801.41,DITEM,"POV")),U) S:TDTXT="" TDTXT=TNAME_$S(TCUR=1:"",1:" (HISTORICAL)")
  1. .S CNT=CNT+1,ARRAY(CNT)=TDTXT_U_80_U_$S(TCUR=1:1,1:2)_U_"POV"
  1. ;Procedures
  1. I TPR D
  1. .S TPTXT=$P($G(^PXRMD(801.41,DITEM,"CPT")),U) S:TPTXT="" TPTXT=TNAME_$S(TCUR=1:"",1:" (HISTORICAL)")
  1. .S CNT=CNT+1,ARRAY(CNT)=TPTXT_U_81_U_$S(TCUR=1:1,1:2)_U_"CPT"
  1. I TSCT D
  1. .S TSCTXT="SNOMED SECTION" S:TSCTXT="" TSCTXT=TNAME_$S(TCUR=1:"",1:" (HISTORICAL)")
  1. .S CNT=CNT+1,ARRAY(CNT)=TSCTXT_U_750.1_U_$S(TCUR=1:1,1:2)_U_"SC"
  1. ;
  1. Q
  1. ;
  1. TAXERROR(DIEN,TIEN) ;
  1. N CNT,DNAME,ERRORTXT,FAIL,HEADER,LINE,NIN,NOUT,OUTPUT,TEMP,TNAME
  1. S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U) Q:DNAME=""
  1. S TNAME=$P($G(^PXD(811.2,TIEN,0)),U)
  1. S HEADER="Problem with dialog in CPRS"
  1. S FAIL=$$CHECKER^PXRMDTAX(DIEN,TIEN,15,.OUTPUT) I FAIL="" Q
  1. S NIN=$O(OUTPUT(""),-1)
  1. D FORMAT^PXRMTEXT(1,75,NIN,.OUTPUT,.NOUT,.TEMP)
  1. S CNT=0 F LINE=1:1:NOUT S CNT=CNT+1,ERRORTXT(CNT,0)=TEMP(LINE)
  1. S CNT=CNT+1,ERRORTXT(CNT,0)="Please review and correct either the taxonomy or the dialog."
  1. S ZTSAVE("HEADER")="",ZTSAVE("ERRORTXT(")=""
  1. D ERROR("Reminder Dialog/Taxonomy Loader check",.ZTSAVE)
  1. Q
  1. ;
  1. AHIS(DITEM) ;
  1. N RSIEN,RSNAM
  1. S RSIEN=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
  1. I RSIEN="" Q 0
  1. S RSNAM=$P($G(^PXRMD(801.9,RSIEN,0)),U)
  1. I RSNAM["DONE ELSEWHERE" Q 1
  1. I RSNAM="CONTRAINDICATED" Q 2
  1. I RSNAM["REFUSED" Q 3
  1. N GUI,PIEN,PFOUND
  1. S PIEN=0,PFOUND=0
  1. F S PIEN=$O(^PXRMD(801.41,DITEM,10,"D",PIEN)) Q:'PIEN D Q:PFOUND
  1. .;Ignore elements and groups
  1. .I "EG"[$P($G(^PXRMD(801.41,PIEN,0)),U,4) Q
  1. .;GUI Process
  1. .S GUI=$P($G(^PXRMD(801.41,PIEN,46)),U) Q:'GUI
  1. .;Check if this is PXRM VISIT DATE (or a copy of it)
  1. .I $P($G(^PXRMD(801.42,GUI,0)),U)="VST_DATE" S PFOUND=1
  1. Q PFOUND
  1. ;