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