PXRMDLL ;SLC/PJH - REMINDER DIALOG LOADER ;09/26/2007 ;;2.0;CLINICAL REMINDERS;**10,6**;Feb 04, 2005;Build 123 ; 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="
"_TEXT S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","
") S LAST=0 I NULL S TEXT="
"_TEXT,LAST=1 Q ; EXP(TIEN,DITEM,DSUB) ;Expand taxonomy codes N ACNT,AHIS,ATYP,ARRAY,CODES,CNT,DPCE,DTAX ;Get taxonomy file details D TAX(TIEN,.ARRAY) ; ;Build dialog from the returned array ; ;Main Taxonomy prompt S DTXT=ARRAY S OCNT=OCNT+1 S ORY(OCNT)=1_U_DITEM_U_DSUB_U_"S"_U_DEXC ;Default group indents and selection entry S $P(ORY(OCNT),U,16)=2,$P(ORY(OCNT),U,18)=2 S OCNT=OCNT+1 S ORY(OCNT)=2_U_DITEM_U_DSUB_U_DTXT ; ;Taxonomy CPT/POV resolution prompts S ACNT="" F S ACNT=$O(ARRAY(ACNT)) Q:ACNT="" D .;Prompt text .S DTXT=$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 .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_DTXT Q ; GROUP(DIEN,DSUB) ;Dialog group N DATA,DBOX,DCAP,DCHK,DENTRY,DEXC,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 DTYP,DSUPP,DDIS,IDENT S DGSEQ=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 DATA=$G(^PXRMD(801.41,DIEN,10,DGSUB,0)) .S DGIEN=$P(DATA,U,2) Q:'DGIEN .;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)) .;Check if element is disabled/invalid .S DATA=$G(^PXRMD(801.41,DGIEN,0)) Q:DATA="" Q:$P(DATA,U,3)]"" .;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" D EXP(DFIEN,DGIEN,DGRP) 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 ; 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 ;Check Status of dialog S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA="" ;If disabled ignore I $P(DATA,U,3)]"" Q ;Ignore if not a reminder dialog I $P(DATA,U,4)'="R" 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" 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:$P(DATA,U,3)]"" .;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) .;Taxonomy codes need expanding .I DPCE="T" D EXP(DFIEN,DITEM,DSUB) 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) .;Done Elsewhere (historical) .S DHIS=$$AHIS(DITEM) .;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,ARRAY) ;Return list of resolutions/codes for taxonomy N CNT,DTXT,FNODE,RSUB,TDX,TNAME,TPAR,TPR,TYP N TCUR,TDTXT,TDHTXT,THIS,TPTXT,TPHTXT ; ;Get taxonomy name S TNAME=$P($G(^PXD(811.2,TXIEN,0)),U,1) ; ;Check what type of taxonomy codes exist S TDX=$$TOK^PXRMDLLA(TXIEN,"SDX") S TPR=$$TOK^PXRMDLLA(TXIEN,"SPR") ; ;Taxonomy dialog text S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,3) ;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 ; ;Diagnoses I TDX D .;Diagnosis texts .S TPAR=$G(^PXD(811.2,TXIEN,"SDZ")) .;Get parameter file node for this finding type .S FNODE=$O(^PXRMD(801.45,"B","POV","")) Q:FNODE="" .;check if finding parameters are disabled .S TCUR=$P($G(^PXRMD(801.45,FNODE,1,1,0)),U,2) .S THIS=$P($G(^PXRMD(801.45,FNODE,1,2,0)),U,2) .;get category text (diagnoses) .I 'TCUR D ; Current ..S TDTXT=$P(TPAR,U,2) S:TDTXT="" TDTXT=TNAME ..S CNT=CNT+1,ARRAY(CNT)=TDTXT_U_80_U_1_U_"POV" .I 'THIS D ; Historical ..S TDHTXT=$P(TPAR,U,3) S:TDHTXT="" TDHTXT=TNAME_" (HISTORICAL)" ..S CNT=CNT+1,ARRAY(CNT)=TDHTXT_U_80_U_2_U_"POV" ;Procedures I TPR D .;Procedure texts .S TPAR=$G(^PXD(811.2,TXIEN,"SPZ")) .;Get parameter file node for this finding type .S FNODE=$O(^PXRMD(801.45,"B","CPT","")) Q:FNODE="" .;check if finding parameters are disabled .S TCUR=$P($G(^PXRMD(801.45,FNODE,1,1,0)),U,2) .S THIS=$P($G(^PXRMD(801.45,FNODE,1,2,0)),U,2) .;get category text (procedures) .I 'TCUR D ; Current ..S TPTXT=$P(TPAR,U,2) S:TPTXT="" TPTXT=TNAME ..S CNT=CNT+1,ARRAY(CNT)=TPTXT_U_81_U_1_U_"CPT" .I 'THIS D ; Historical ..S TPHTXT=$P(TPAR,U,3) S:TPHTXT="" TPHTXT=TNAME_" (HISTORICAL)" ..S CNT=CNT+1,ARRAY(CNT)=TPHTXT_U_81_U_2_U_"CPT" ; 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