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

PXRMTDLG.m

Go to the documentation of this file.
  1. PXRMTDLG ; SLC/PJH - Edit/Inquire Taxonomy Dialog ;9/7/2012
  1. ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
  1. ;
  1. ;Called by option PXRM TAXONOMY DIALOG
  1. ;
  1. START N DIC,PXRMGTYP,PXRMHD,PXRMTIEN,Y
  1. SELECT ;General selection
  1. S PXRMHD="Taxonomy Dialog",PXRMGTYP="DTAX",PXRMTIEN=""
  1. D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMTIEN")
  1. ;Should return a value
  1. I PXRMTIEN D G SELECT
  1. .S PXRMHD="TAXONOMY NAME:"
  1. .;Listman option
  1. .D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMTIEN)
  1. ;
  1. END Q
  1. ;
  1. ;List all Taxonomy Dialogs (for protocol PXRM SELECTION LIST)
  1. ;-------------------------
  1. ALL N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO,Y
  1. S Y=1
  1. D SET
  1. S DIC="^PXD(811.2,"
  1. S BY=".01"
  1. S FR=""
  1. S TO=""
  1. S DHD="W ?0 D HED^PXRMTDLG"
  1. D DISP
  1. Q
  1. ;
  1. ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
  1. ;--------------------
  1. INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
  1. S DIC="^PXD(811.2,"
  1. S DIC(0)="AEMQ"
  1. D SET
  1. D DISP
  1. Q
  1. ;
  1. ;Display Header (see DHD variable)
  1. ;--------------
  1. HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
  1. S TEXTHED="TAXONOMY DIALOG LIST"
  1. S TEXTUND=$TR($J("",IOM)," ","-")
  1. S TEMP=NOW_" Page "_DC
  1. S TEXTLEN=$L(TEMP)
  1. W TEXTHED
  1. W ?(IOM-TEXTLEN),TEMP
  1. W !,TEXTUND,!!
  1. Q
  1. ;
  1. ;DISPLAY (Display from FLDS array)
  1. ;-------
  1. DISP S L=0,FLDS="[PXRM TAXONOMY DIALOG]"
  1. D EN1^DIP
  1. Q
  1. ;
  1. SET ;Setup all the variables
  1. ; Set Date for Header
  1. S NOW=$$NOW^XLFDT
  1. S NOW=$$FMTE^XLFDT(NOW,"1P")
  1. ;
  1. ;These variables need to be setup every time because DIP kills them.
  1. S BY="NUMBER"
  1. S (FR,TO)=+$P(Y,U,1)
  1. S DHD="W ?0 D HED^PXRMTDLG"
  1. ;
  1. Q
  1. ;
  1. ;Build display for selected taxonomy - Called from PXRMGEN
  1. ;---------------------------------------------------------
  1. DTAX(TIEN) ;
  1. ;If dialog selectable codes don't exist build them
  1. I ('$D(^PXD(811.2,TIEN,"SDX")))&('$D(^PXD(811.2,TIEN,"SPR"))) D
  1. .D BUILD^PXRMTDUP(TIEN)
  1. ;
  1. N ARRAY,CNT,SEQ,TSEQ
  1. S VALMCNT=0 K ^TMP("PXRMGEN",$J)
  1. ;Format headings to include taxonomy name
  1. S HEADER=PXRMHD_" "_$P(^PXD(811.2,TIEN,0),U)
  1. ;Get associated codes
  1. D TAX^PXRMDLL(TIEN,.ARRAY)
  1. ;Taxonomy header
  1. S SEQ=1,TSEQ=$J(SEQ,3)_" "
  1. S CNT=0,VALMCNT=VALMCNT+1
  1. S ^TMP("PXRMGEN",$J,VALMCNT,0)=TSEQ_$J("",15-$L(TSEQ))_ARRAY
  1. ;Dialog and Procedure entries
  1. F S CNT=$O(ARRAY(CNT)) Q:CNT="" D
  1. .S TSEQ=$J(SEQ,3)_"."_CNT
  1. .S VALMCNT=VALMCNT+1
  1. .S ^TMP("PXRMGEN",$J,VALMCNT,0)=TSEQ_$J("",15-$L(TSEQ))_$P(ARRAY(CNT),U)
  1. .D CODES($P(ARRAY(CNT),U,2),TIEN)
  1. .S VALMCNT=VALMCNT+1
  1. .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
  1. ;Create headings
  1. D CHGCAP^VALM("HEADER1","Taxonomy Dialog")
  1. D CHGCAP^VALM("HEADER2","")
  1. D CHGCAP^VALM("HEADER3","")
  1. Q
  1. ;
  1. ;Selectable codes
  1. ;----------------
  1. CODES(FILE,TIEN) ;
  1. N BDATE,CODES,CODE,DATES,DESC,DTEXT,EDATE,STR,SUB,TAB,TEXT
  1. ;Display text
  1. S TEXT=$J("",15)_"Selectable codes:",TAB=18
  1. S STR=$$LJ^XLFSTR($G(TEXT),60)
  1. S STR=STR_"Activation Periods"
  1. S VALMCNT=VALMCNT+1
  1. ;S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_$G(TEXT)
  1. S ^TMP("PXRMGEN",$J,VALMCNT,0)=STR
  1. ;Get array
  1. D CODES^PXRMDLLB(FILE,TIEN,.CODES)
  1. ;Move results into workfile
  1. S SUB=""
  1. F S SUB=$O(CODES(SUB)) Q:SUB="" D
  1. .S CODE=$P(CODES(SUB),U,2),DESC=$P(CODES(SUB),U,3)
  1. .S BDATE=$$FMTE^XLFDT($P($G(CODE),":",2))
  1. .I $P($G(CODE),":",3)'="" S EDATE=$$FMTE^XLFDT($P($G(CODE),":",3))
  1. .S DATE=BDATE I $G(EDATE)'="" S DATE=DATE_"-"_EDATE
  1. .S STR=$$LJ^XLFSTR($P($G(CODE),":"),8)
  1. .S STR=STR_$$LJ^XLFSTR(DESC,37)
  1. .S DTEXT=STR_DATE
  1. .S VALMCNT=VALMCNT+1
  1. .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",15)_DTEXT
  1. .;S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_$G(TEXT)_DTEXT
  1. .;S TEXT=$J("",TAB)
  1. Q
  1. ;
  1. ;Display selectable codes - called from print template
  1. ;-----------------------------------------------------
  1. TDES(FILE,D0,D1) ;
  1. N CNT,CODE,DATA,IEN,TEMP,TEXT,NODE
  1. S NODE=$S(FILE=80:"SDX",FILE=81:"SPR")
  1. S DATA=$G(^PXD(811.2,D0,NODE,D1,0)) Q:DATA=""
  1. ;Get ien of code
  1. S IEN=$P(DATA,U) Q:IEN=""
  1. S TEMP=$S(FILE=80:$$ICDDX^ICDCODE(IEN,DT),FILE=81:$$CPT^ICPTCOD(IEN,DT))
  1. S CODE=$P(TEMP,U,2)
  1. ;Set display text from taxonomy selectable code text
  1. ;otherwise use icd9/cpt diagnosis or short name.
  1. S TEXT=$P(DATA,U,2)
  1. ;Check for an invalid code.
  1. I $P(TEMP,U,1)=-1 S CODE=$$CODEC^ICDCODE(IEN),TEXT=$P(TEMP,U,2)_" (invalid code)"
  1. I TEXT="" S TEXT=$S(FILE=80:$P(TEMP,U,4),FILE=81:$P(TEMP,U,3))
  1. S TEXT=" "_$E(TEXT,1,40)_$J("",40-$L(TEXT))
  1. ;Lineup file 80 codes on the ".".
  1. I FILE=80,$L(CODE)=5 S CODE=CODE_" "
  1. W $J(CODE,10)_TEXT
  1. Q