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 Apr 09, 2024@20:48:49 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
