PXRMDLL ;SLC/PJH - REMINDER DIALOG LOADER ;05/12/2014
;;2.0;CLINICAL REMINDERS;**10,6,12,17,18,26**;Feb 04, 2005;Build 404
;
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) ;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
.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
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
.S OCNT=OCNT+1
.I BOTH=0 Q
.S DEXC=1
.S ORY(OCNT)=1_U_DITEM_U_DTAX_U_"T"_U_DEXC_U_U_ATYP_U_AHIS
.S OCNT=OCNT+1
.S ORY(OCNT)=2_U_DITEM_U_DTAX_U_TAXTEXT
Q
;
GROUP(DIEN,DSUB) ;Dialog group
N DATA,DBOX,DCAP,DCHK,DENTRY,DEXC,DCCNT,DGIEN,DGRP,DGSEQ,DGSUB,DHIDE,DIND
N DINDPN,DMHEX,DRESL,DSHARE,SUB,DCOUNT
;Group caption text
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 DCHK="S" I ('DHIDE)&(DSUPP) S DCHK="D",DHIDE=0
;Default group setting to hide
I DHIDE="" S DHIDE=1
;
S DEXC=$P($G(^PXRMD(801.41,DIEN,2)),U,3)
;
S OCNT=OCNT+1,ORY(OCNT)=1_U_DIEN_U_DSUB_U_DCHK_U_DEXC
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
;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
N DGCNT,DTYP,DSUPP,DDIS,IDENT S DGSEQ=0,DGCNT=0
F S DGSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ)) Q:'DGSEQ 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 DGIEN=$P(DATA,U,2) Q:'DGIEN
.;Check if element is disabled/invalid
.I $$ISDISAB(DGIEN)=1 Q
.;Branching logic call to determine if element should be suppress,
.;replace or left as is
.N TERMNODE,TERMSTAT
.S TERMNODE=$G(^PXRMD(801.41,DGIEN,49))
.I $G(TERMNODE)'="" D Q:TERMSTAT=0
..S TERMSTAT=1
..D REPLACE^PXRMDLLB(DFN,TERMNODE,.DGIEN,.DATA,.TERMSTAT)
.;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))
.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
.;Taxonomy codes need expanding
.I DPCE="T",DTYP'="G" D EXP(DFIEN,DGIEN,DGRP,DEXC,DMHEX,DRESL,.DTXT) 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) Q
.S DDIS="S" I DSUPP=1 S DDIS="D"
.S DGRP=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)
.;
.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 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
;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"
;
;Get elements for the dialog
S DSEQ=0,OCNT=0
F S DSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ)) Q:'DSEQ D
.S DSUB=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ,"")) Q:'DSUB
.S DATA=$G(^PXRMD(801.41,DIEN,10,DSUB,0))
.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
.;Branching logic call to determine if element should be suppress,
.;replace or left as is
.S TERMNODE=$G(^PXRMD(801.41,DITEM,49))
.N TERMSTAT
.I $G(TERMNODE)'="" D Q:TERMSTAT=0
..S TERMSTAT=1
..D REPLACE^PXRMDLLB(DFN,TERMNODE,.DITEM,.DATA,.TERMSTAT)
.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
.F S SUB=$O(^PXRMD(801.41,DITEM,25,SUB)) Q:'SUB D
..S DTXT(SUB)=$G(^PXRMD(801.41,DITEM,25,SUB,0))
.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))
.;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,DSUB,DEXC,DMHEX,DRESL,.DTXT) 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) Q
.;Dialog type/text and resolution
.S OCNT=OCNT+1,DDIS="S"
.I DSUPP=1 S DDIS="D"
.S ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
.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_DSUB_U_TEXT
Q
;
TAX(TXIEN,DITEM,TEXT,ARRAY) ;Return list of resolutions/codes for taxonomy
N CNT,DXNODE,DTXT,FAIL,HISTIEN,NODE,NUM,PRNODE,RESULT,RESVALUE,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=1 S ERRORTXT(CNT,0)="Dialog "_DNAME_" and taxonomy "_TNAME_" structures do not match."
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
PXRMDLL ;SLC/PJH - REMINDER DIALOG LOADER ;05/12/2014
+1 ;;2.0;CLINICAL REMINDERS;**10,6,12,17,18,26**;Feb 04, 2005;Build 404
+2 ;
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) ;Expand taxonomy codes
+1 NEW ACNT,AHIS,ATYP,ARRAY,BOTH,CODES,CNT,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 IF TSEL'="N"
SET BOTH=$$TAX(TIEN,DITEM,TEXT,.ARRAY)
+9 IF TSEL'="N"
IF '$DATA(ARRAY)
QUIT
+10 SET DHIS=$$AHIS(DITEM)
+11 ;
+12 ;Build dialog from the returned array
+13 ;
+14 SET OCNT=OCNT+1
+15 ;this is new for Taxonomy selection types of N
+16 IF TSEL="N"
Begin DoDot:1
+17 NEW LAST,TEXT
+18 SET ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
+19 SET SUB=0
SET LAST=0
FOR
SET SUB=$ORDER(DTXT(SUB))
IF 'SUB
QUIT
Begin DoDot:2
+20 DO TXT
+21 SET OCNT=OCNT+1
SET ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
End DoDot:2
End DoDot:1
QUIT
+22 ;Main Taxonomy prompt
+23 ;Default group indents and selection entry
+24 SET TAXTEXT=ARRAY
+25 ;S ORY(OCNT)=1_U_DITEM_U_DSUB_U_"S"_U_DEXC
+26 SET ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC
+27 SET $PIECE(ORY(OCNT),U,16)=2
SET $PIECE(ORY(OCNT),U,18)=$SELECT(BOTH=1:2,1:0)
SET $PIECE(ORY(OCNT),U,8)=DHIS
+28 NEW LAST,TEXT
+29 SET TEXT=""
+30 SET SUB=0
SET LAST=0
FOR
SET SUB=$ORDER(DTXT(SUB))
IF 'SUB
QUIT
Begin DoDot:1
+31 DO TXT
+32 SET OCNT=OCNT+1
+33 SET ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
End DoDot:1
+34 ;
+35 ;Taxonomy CPT/POV resolution prompts
+36 SET ACNT=""
+37 FOR
SET ACNT=$ORDER(ARRAY(ACNT))
IF ACNT=""
QUIT
Begin DoDot:1
+38 ;Prompt text
+39 SET TAXTEXT=$PIECE(ARRAY(ACNT),U)
SET DPCE=$PIECE(ARRAY(ACNT),U,4)
+40 ;Historical/Current flag
+41 SET AHIS=0
IF $PIECE(ARRAY(ACNT),U,3)=2
SET AHIS=1
+42 ;CPT/POV
+43 SET ATYP="POV"
IF $PIECE(ARRAY(ACNT),U,2)=81
SET ATYP="CPT"
+44 ;Initial display
+45 SET DHIDE=0
SET DCHECK=0
SET DDIS=0
+46 ;Construct ien for this level
+47 SET DTAX=DSUB_"."_ACNT
+48 SET OCNT=OCNT+1
+49 IF BOTH=0
QUIT
+50 SET DEXC=1
+51 SET ORY(OCNT)=1_U_DITEM_U_DTAX_U_"T"_U_DEXC_U_U_ATYP_U_AHIS
+52 SET OCNT=OCNT+1
+53 SET ORY(OCNT)=2_U_DITEM_U_DTAX_U_TAXTEXT
End DoDot:1
+54 QUIT
+55 ;
GROUP(DIEN,DSUB) ;Dialog group
+1 NEW DATA,DBOX,DCAP,DCHK,DENTRY,DEXC,DCCNT,DGIEN,DGRP,DGSEQ,DGSUB,DHIDE,DIND
+2 NEW DINDPN,DMHEX,DRESL,DSHARE,SUB,DCOUNT
+3 ;Group caption text
+4 SET DATA=$GET(^PXRMD(801.41,DIEN,0))
+5 SET DCAP=$PIECE(DATA,U,5)
SET DBOX=$PIECE(DATA,U,6)
SET DIND=$PIECE(DATA,U,7)
+6 SET DSHARE=$PIECE(DATA,U,8)
SET DENTRY=$PIECE(DATA,U,9)
SET DHIDE=$PIECE(DATA,U,10)
+7 SET DINDPN=$PIECE(DATA,U,12)
IF DINDPN=""
SET DINDPN=0
+8 SET DBOX=$SELECT(DBOX="Y":1,1:"")
+9 ;group header is display only if SUPPRESS CHECKBOX
+10 SET DCHK="S"
IF ('DHIDE)&(DSUPP)
SET DCHK="D"
SET DHIDE=0
+11 ;Default group setting to hide
+12 IF DHIDE=""
SET DHIDE=1
+13 ;
+14 SET DEXC=$PIECE($GET(^PXRMD(801.41,DIEN,2)),U,3)
+15 ;
+16 SET OCNT=OCNT+1
SET ORY(OCNT)=1_U_DIEN_U_DSUB_U_DCHK_U_DEXC
+17 SET $PIECE(ORY(OCNT),U,8)=$$AHIS(DIEN)
+18 SET $PIECE(ORY(OCNT),U,15)=DHIDE
SET $PIECE(ORY(OCNT),U,16)=DIND
+19 SET $PIECE(ORY(OCNT),U,17)=DSHARE
SET $PIECE(ORY(OCNT),U,18)=DENTRY
+20 SET $PIECE(ORY(OCNT),U,19)=DBOX
SET $PIECE(ORY(OCNT),U,20)=DCAP
+21 SET $PIECE(ORY(OCNT),U,21)=DINDPN
+22 ;Create type 2 records if if here is additional group text
+23 NEW LAST,TEXT
+24 SET SUB=0
SET LAST=0
FOR
SET SUB=$ORDER(DTXT(SUB))
IF 'SUB
QUIT
Begin DoDot:1
+25 DO TXT
+26 SET OCNT=OCNT+1
SET ORY(OCNT)=2_U_DIEN_U_DSUB_U_TEXT
End DoDot:1
+27 ;Get dialog group sub-elements
+28 NEW DGCNT,DTYP,DSUPP,DDIS,IDENT
SET DGSEQ=0
SET DGCNT=0
+29 FOR
SET DGSEQ=$ORDER(^PXRMD(801.41,DIEN,10,"B",DGSEQ))
IF 'DGSEQ
QUIT
Begin DoDot:1
+30 SET DGSUB=$ORDER(^PXRMD(801.41,DIEN,10,"B",DGSEQ,""))
IF 'DGSUB
QUIT
+31 SET DGCNT=DGCNT+1
+32 SET DATA=$GET(^PXRMD(801.41,DIEN,10,DGSUB,0))
+33 SET DGIEN=$PIECE(DATA,U,2)
IF 'DGIEN
QUIT
+34 ;Check if element is disabled/invalid
+35 IF $$ISDISAB(DGIEN)=1
QUIT
+36 ;Branching logic call to determine if element should be suppress,
+37 ;replace or left as is
+38 NEW TERMNODE,TERMSTAT
+39 SET TERMNODE=$GET(^PXRMD(801.41,DGIEN,49))
+40 IF $GET(TERMNODE)'=""
Begin DoDot:2
+41 SET TERMSTAT=1
+42 DO REPLACE^PXRMDLLB(DFN,TERMNODE,.DGIEN,.DATA,.TERMSTAT)
End DoDot:2
IF TERMSTAT=0
QUIT
+43 ;Exclude from P/N
+44 SET DEXC=$PIECE(DATA,U,8)
+45 IF $PIECE($GET(^PXRMD(801.41,DGIEN,0)),U,16)'["WHR"
Begin DoDot:2
+46 KILL DTXT
SET SUB=0
FOR
SET SUB=$ORDER(^PXRMD(801.41,DGIEN,25,SUB))
IF 'SUB
QUIT
Begin DoDot:3
+47 SET DTXT(SUB)=$GET(^PXRMD(801.41,DGIEN,25,SUB,0))
End DoDot:3
End DoDot:2
+48 SET DATA=$GET(^PXRMD(801.41,DGIEN,0))
+49 ;If the actual element is exclude from P/N override
+50 IF $PIECE($GET(^PXRMD(801.41,DGIEN,2)),U,3)
SET DEXC=1
+51 SET DTYP=$PIECE(DATA,U,4)
SET DSUPP=$PIECE(DATA,U,11)
IF "EG"'[DTYP
QUIT
+52 SET DMHEX=$PIECE(DATA,U,14)
+53 SET DRESL=$$RESGROUP^PXRMDLLB(DGIEN)
+54 ;S DRESL=$P(DATA,U,15)
+55 SET DRES=$PIECE($GET(^PXRMD(801.41,DGIEN,1)),U,3)
+56 ;Done Elsewhere (historical)
+57 SET DHIS=$$AHIS(DGIEN)
+58 SET DFIND=$PIECE($GET(^PXRMD(801.41,DGIEN,1)),U,5)
+59 SET DFIEN=$PIECE(DFIND,";")
SET DFTYP=$PIECE(DFIND,";",2)
+60 SET DPCE=""
IF DFTYP'=""
SET DPCE=$GET(DARRAY(DFTYP))
+61 ;If mental Health ignore if not GUI
+62 IF DPCE="MH"
IF '$$OK(DFIEN)
QUIT
+63 SET DGRP=DSUB_"."_DGSUB
+64 ;Taxonomy codes need expanding
+65 IF DPCE="T"
IF DTYP'="G"
DO EXP(DFIEN,DGIEN,DGRP,DEXC,DMHEX,DRESL,.DTXT)
QUIT
+66 ;Translate vitals ien to PCE code - This will need a DBIA
+67 IF DPCE="VIT"
SET DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
+68 ;Embedded Dialog Group
+69 IF DTYP="G"
DO GROUP(DGIEN,DGRP)
QUIT
+70 SET DDIS="S"
IF DSUPP=1
SET DDIS="D"
+71 SET DGRP=DSUB_"."_DGSUB
SET OCNT=OCNT+1
+72 SET ORY(OCNT)=1_U_DGIEN_U_DGRP_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL_U_$GET(DCOUNT)
+73 ;
+74 NEW LAST,TEXT
+75 SET SUB=0
SET LAST=0
FOR
SET SUB=$ORDER(DTXT(SUB))
IF 'SUB
QUIT
Begin DoDot:2
+76 DO TXT
+77 SET OCNT=OCNT+1
SET ORY(OCNT)=2_U_DGIEN_U_DGRP_U_TEXT
End DoDot:2
End DoDot:1
+78 QUIT
+79 ;
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) ;Load dialog questions into array
+1 NEW 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 ;Check Status of dialog
+4 SET DATA=$GET(^PXRMD(801.41,DIEN,0))
IF DATA=""
QUIT
+5 ;If disabled ignore
+6 IF $$ISDISAB(DIEN)=1
QUIT
+7 ;Ignore if not a reminder dialog
+8 IF $PIECE(DATA,U,4)'="R"
QUIT
+9 ;check for disable evaluation disable if it contains branching logic
+10 SET REINDX=0
+11 IF $DATA(^XTMP("PXRM_DISEV",0))
Begin DoDot:1
+12 SET ORY(1)=1_U_U_"1"_U_"D"_U_"1"_U_U_U_"0"_U_U
+13 SET ORY(2)=2_U_U_"1"_U_"Dialog is disable for reminder re-indexing"
+14 SET REINDX=1
End DoDot:1
+15 IF REINDX=1
QUIT
+16 ;List of PCE codes
+17 SET DARRAY("AUTTEDT(")="PED"
+18 SET DARRAY("AUTTEXAM(")="XAM"
+19 SET DARRAY("AUTTHF(")="HF"
+20 SET DARRAY("AUTTIMM(")="IMM"
+21 SET DARRAY("AUTTSK(")="SK"
+22 SET DARRAY("GMRD(120.51,")="VIT"
+23 SET DARRAY("ORD(101.41,")="Q"
+24 SET DARRAY("YTT(601.71,")="MH"
+25 ;AGP TODO before release ICD9 and CPT can be deleted
+26 SET DARRAY("ICD9(")="POV"
+27 SET DARRAY("ICPT(")="CPT"
+28 SET DARRAY("PXD(811.2,")="T"
+29 SET DARRAY("WV(790.1,")="WHR"
+30 ;
+31 ;Get elements for the dialog
+32 SET DSEQ=0
SET OCNT=0
+33 FOR
SET DSEQ=$ORDER(^PXRMD(801.41,DIEN,10,"B",DSEQ))
IF 'DSEQ
QUIT
Begin DoDot:1
+34 SET DSUB=$ORDER(^PXRMD(801.41,DIEN,10,"B",DSEQ,""))
IF 'DSUB
QUIT
+35 SET DATA=$GET(^PXRMD(801.41,DIEN,10,DSUB,0))
+36 SET DITEM=$PIECE(DATA,U,2)
IF DITEM=""
QUIT
+37 ;Ignore disabled elements
+38 SET DATA=$GET(^PXRMD(801.41,DITEM,0))
IF DATA=""
QUIT
IF $$ISDISAB(DITEM)=1
QUIT
+39 ;Branching logic call to determine if element should be suppress,
+40 ;replace or left as is
+41 SET TERMNODE=$GET(^PXRMD(801.41,DITEM,49))
+42 NEW TERMSTAT
+43 IF $GET(TERMNODE)'=""
Begin DoDot:2
+44 SET TERMSTAT=1
+45 DO REPLACE^PXRMDLLB(DFN,TERMNODE,.DITEM,.DATA,.TERMSTAT)
End DoDot:2
IF TERMSTAT=0
QUIT
+46 SET DTYP=$PIECE(DATA,U,4)
SET DSUPP=$PIECE(DATA,U,11)
+47 SET DMHEX=$PIECE(DATA,U,14)
+48 SET DRESL=$$RESGROUP^PXRMDLLB(DITEM)
+49 ;S DRESL=$P(DATA,U,15)
+50 KILL DTXT
SET SUB=0
+51 FOR
SET SUB=$ORDER(^PXRMD(801.41,DITEM,25,SUB))
IF 'SUB
QUIT
Begin DoDot:2
+52 SET DTXT(SUB)=$GET(^PXRMD(801.41,DITEM,25,SUB,0))
End DoDot:2
+53 SET DRES=$PIECE($GET(^PXRMD(801.41,DITEM,1)),U,3)
+54 SET DFIND=$PIECE($GET(^PXRMD(801.41,DITEM,1)),U,5)
+55 SET DFIEN=$PIECE(DFIND,";")
SET DFTYP=$PIECE(DFIND,";",2)
+56 SET DPCE=""
IF DFTYP'=""
SET DPCE=$GET(DARRAY(DFTYP))
+57 ;If mental Health ignore if not GUI
+58 IF DPCE="MH"
IF '$$OK(DFIEN)
QUIT
+59 ;Exclude from PN
+60 SET DEXC=$PIECE($GET(^PXRMD(801.41,DITEM,2)),U,3)
+61 ;Done Elsewhere (historical)
+62 SET DHIS=$$AHIS(DITEM)
+63 ;Taxonomy codes need expanding
+64 IF DPCE="T"
IF DTYP'="G"
DO EXP(DFIEN,DITEM,DSUB,DEXC,DMHEX,DRESL,.DTXT)
QUIT
+65 ;Translate vitals ien to PCE code - This will need a DBIA
+66 IF DPCE="VIT"
SET DFIEN=$PIECE($GET(^GMRD(120.51,DFIEN,0)),U,7)
+67 ;Dialog Group
+68 IF DTYP="G"
DO GROUP(DITEM,DSUB)
QUIT
+69 ;Dialog type/text and resolution
+70 SET OCNT=OCNT+1
SET DDIS="S"
+71 IF DSUPP=1
SET DDIS="D"
+72 SET ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
+73 NEW LAST,TEXT
+74 SET SUB=0
SET LAST=0
FOR
SET SUB=$ORDER(DTXT(SUB))
IF 'SUB
QUIT
Begin DoDot:2
+75 DO TXT
+76 SET OCNT=OCNT+1
SET ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
End DoDot:2
End DoDot:1
+77 QUIT
+78 ;
TAX(TXIEN,DITEM,TEXT,ARRAY) ;Return list of resolutions/codes for taxonomy
+1 NEW CNT,DXNODE,DTXT,FAIL,HISTIEN,NODE,NUM,PRNODE,RESULT,RESVALUE,TNAME,TSEL,TYPE
+2 NEW TDTXT,TDHTXT,TPTXT,TPHTXT
+3 ;
+4 ;Get taxonomy name
+5 SET 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 RESULT
+8 ;
+9 SET TDX=$$TOK^PXRMDTAX(TXIEN,"POV")
+10 SET TPR=$$TOK^PXRMDTAX(TXIEN,"CPT")
+11 SET NODE=$GET(^PXRMD(801.41,DITEM,"TAX"))
+12 SET TSEL=$PIECE(NODE,U)
+13 DO TAXERROR(DITEM,TXIEN)
+14 ;
+15 SET DTXT=""
+16 ;Taxonomy dialog text
+17 IF DTXT=""
SET DTXT=$PIECE(NODE,U,4)
+18 ;default to taxonomy description if null
+19 IF DTXT=""
SET DTXT=$PIECE($GET(^PXD(811.2,TXIEN,0)),U,2)
+20 ;default to taxonomy name if null
+21 IF DTXT=""
SET DTXT=$PIECE($GET(^PXD(811.2,TXIEN,0)),U,1)
+22 ;
+23 SET CNT=0
SET ARRAY=DTXT
+24 ;
+25 ;make sure dialog is set to display diagnoses/procedure selection list
+26 IF TDX
SET TDX=$SELECT("AD"[TSEL:1,1:0)
+27 IF TPR
SET TPR=$SELECT("AP"[TSEL:1,1:0)
+28 IF TDX
IF TPR
SET RESULT=1
+29 SET HISTIEN=$ORDER(^PXRMD(801.9,"B","DONE ELSEWHERE (HISTORICAL)",""))
+30 SET RESVALUE=$PIECE($GET(^PXRMD(801.41,DITEM,1)),U,3)
+31 SET TCUR=$SELECT(RESVALUE'=HISTIEN:1,1:0)
+32 ;Diagnoses
+33 IF TDX
Begin DoDot:1
+34 SET TDTXT=$PIECE($GET(^PXRMD(801.41,DITEM,"POV")),U)
IF TDTXT=""
SET TDTXT=TNAME_$SELECT(TCUR=1:"",1:" (HISTORICAL)")
+35 SET CNT=CNT+1
SET ARRAY(CNT)=TDTXT_U_80_U_$SELECT(TCUR=1:1,1:2)_U_"POV"
End DoDot:1
+36 ;Procedures
+37 IF TPR
Begin DoDot:1
+38 SET TPTXT=$PIECE($GET(^PXRMD(801.41,DITEM,"CPT")),U)
IF TPTXT=""
SET TPTXT=TNAME_$SELECT(TCUR=1:"",1:" (HISTORICAL)")
+39 SET CNT=CNT+1
SET ARRAY(CNT)=TPTXT_U_81_U_$SELECT(TCUR=1:1,1:2)_U_"CPT"
End DoDot:1
+40 ;
+41 QUIT RESULT
+42 ;
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 ;S CNT=1 S ERRORTXT(CNT,0)="Dialog "_DNAME_" and taxonomy "_TNAME_" structures do not match."
+10 SET CNT=CNT+1
SET ERRORTXT(CNT,0)="Please review and correct either the taxonomy or the dialog."
+11 SET ZTSAVE("HEADER")=""
SET ZTSAVE("ERRORTXT(")=""
+12 DO ERROR("Reminder Dialog/Taxonomy Loader check",.ZTSAVE)
+13 QUIT
+14 ;
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 NEW GUI,PIEN,PFOUND
+7 SET PIEN=0
SET PFOUND=0
+8 FOR
SET PIEN=$ORDER(^PXRMD(801.41,DITEM,10,"D",PIEN))
IF 'PIEN
QUIT
Begin DoDot:1
+9 ;Ignore elements and groups
+10 IF "EG"[$PIECE($GET(^PXRMD(801.41,PIEN,0)),U,4)
QUIT
+11 ;GUI Process
+12 SET GUI=$PIECE($GET(^PXRMD(801.41,PIEN,46)),U)
IF 'GUI
QUIT
+13 ;Check if this is PXRM VISIT DATE (or a copy of it)
+14 IF $PIECE($GET(^PXRMD(801.42,GUI,0)),U)="VST_DATE"
SET PFOUND=1
End DoDot:1
IF PFOUND
QUIT
+15 QUIT PFOUND
