- 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 Jan 18, 2025@02:45:16 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 ;