PXRMP26X ;SLC/AGP - Dialog Conversion Extra routine for PXRM*2.0*26. ;01/02/2014
;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
Q
;
;build an XTMP value of dialogs that contains Taxonomy, ICD9 codes, and/or CPT codes.
;if ICD9 or CPT deletes the values from file 801.41
BLDLIST(PXRMSKIP) ;
K ^TMP($J,"DLG FIND"),^TMP($J,"DLG ORDER")
D MES^XPDUTL("Building lists of dialogs to update")
D BLDDLGTM^PXRMSTS("DLG FIND")
N ADD,ADDFNDS,ADDFVPL,CNT,DIEN,FIND,FINDFVPL,IEN,NAME,NUM,TEMP,TYPE
D BLDRLIST^PXRMVPTR(801.41,15,.FINDFVPL)
D BLDRLIST^PXRMVPTR(801.4118,.01,.ADDFVPL)
K ^TMP("PXRMXMZ",$J)
S ^TMP("PXRMXMZ",$J,1,0)="Dialog pre-conversion report:"
F TYPE="ICD9(","ICPT(","PXD(811.2," D
.S IEN=0 F S IEN=$O(^TMP($J,"DLG FIND",TYPE,IEN)) Q:IEN'>0 D
..S DIEN=0 F S DIEN=$O(^TMP($J,"DLG FIND",TYPE,IEN,DIEN)) Q:DIEN'>0 D
...S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
...;If field is set assume conversion has already happen.
...I TYPE="PXD(811.2,",$P($G(^PXRMD(801.41,DIEN,"TAX")),U)'="" Q
...;If taxonomy is assigned as an additional finding assume conversion has already happen
...I TYPE="PXD(811.2,",$D(^TMP($J,"DLG FIND",TYPE,IEN,DIEN,18)) Q
...I '$D(PXRMSKIP(NAME)) D BLDXTMP(TYPE,DIEN,IEN,.FINDFVPL,.ADDFVPL)
...I TYPE="PXD(811.2," Q
...;
...F FIND=15,18 D
....I FIND=15,$D(^TMP($J,"DLG FIND",TYPE,IEN,DIEN,FIND)) S TEMP(15,DIEN)="" Q
....S NUM=0 F S NUM=$O(^TMP($J,"DLG FIND",TYPE,IEN,DIEN,FIND,NUM)) Q:NUM'>0 S TEMP(18,DIEN,NUM)=""
I $D(^TMP($J,"DLG ORDER")) S DIEN=0 F S DIEN=$O(^TMP($J,"DLG ORDER",DIEN)) Q:DIEN'>0 D BLDTXT(DIEN,.FINDFVPL,.ADDFVPL,0,1)
I '$D(TEMP) G BLDLISTX
F FIND=15,18 D
.S DIEN="" F S DIEN=$O(TEMP(FIND,DIEN)) Q:DIEN'>0 D
..I FIND=15 D DELDATA(DIEN,FIND) Q
..S NUM="" F S NUM=$O(TEMP(FIND,DIEN,NUM)) Q:NUM'>0 D DELDATA(DIEN,FIND,NUM)
BLDLISTX ;
I $O(^TMP("PXRMXMZ",$J,""),-1)>1 D SEND^PXRMMSG("PXRMXMZ","Clinical Reminder Patch 26 Pre-conversion dialog.")
K ^TMP("PXRMXMZ",$J)
Q
;
BLDTXT(DIEN,FINDFVPL,ADDFVPL,TAXNEEDS,PRE) ;
N ADD,CNT,CPTTEXT,NAME,NODE,NUM,POVTEXT,RES,TEXT,TEMP,TSEL
S CNT=+$O(^TMP("PXRMXMZ",$J,""),-1)
I CNT>0 S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
S NODE=$G(^PXRMD(801.41,DIEN,0))
S NAME=$P(NODE,U)
S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=NAME
S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="======================================================="
;
S TEMP=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
;S TEMP=$P($G(^PXRMD(801.41,DIEN,1)),U,5),RES=+$P($G(^PXRMD(801.41,DIEN,1)),U,3)
I TAXNEEDS=1 D
.S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="PREVIOUSLY THE DIALOG WAS SET TO BOTH CURRENT AND HISTORICAL ENCOUNTERS."
.S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="DIALOG IS NOW SET TO CURRENT ENCOUNTER ONLY."
.S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="REVIEW THE DIALOG BEFORE USING IN CPRS."
S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Resolution Type:",25)_" "_$$GET1^DIQ(801.41,DIEN,13)
I TEMP'="" D
.S TEXT=$$BLDTXTF(TEMP,.FINDFVPL)
.S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Finding Item:",25)_" "_TEXT
.D LISTCODE(DIEN,TEXT,TEMP,.CNT,0)
.S TSEL=$$GET1^DIQ(801.41,DIEN,123)
.I PRE=0 S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Taxonomy Pick List:",25)_" "_$G(TSEL)
.S CPTTEXT="",POVTEXT=""
.I "AD"[TSEL S POVTEXT=$$GET1^DIQ(801.41,DIEN,141)
.I "AP"[TSEL S CPTTEXT=$$GET1^DIQ(801.41,DIEN,142)
.I $G(POVTEXT)'="" S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Diagnosis Header:",25)_" "_POVTEXT
.I $G(CPTTEXT)'="" S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Procedure Header:",25)_" "_CPTTEXT
;
I $D(^PXRMD(801.41,DIEN,3,0)) D
.S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
.S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Additional Finding Items:",25)
.S ADD="" F S ADD=$O(^PXRMD(801.41,DIEN,3,"B",ADD)) Q:ADD="" D
..S TEXT=$$BLDTXTF(ADD,.ADDFVPL)
..S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" Items: "_TEXT
..D LISTCODE(DIEN,TEXT,ADD,.CNT,1)
I $P($G(^PXRMD(801.41,DIEN,2)),U,5)=1 D
.S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
.S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="Suppress All Prompts: Yes"
I $D(^PXRMD(801.41,DIEN,10)) D
. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Components:",15)
. S NUM=0 F S NUM=$O(^PXRMD(801.41,DIEN,10,NUM)) Q:NUM'>0 D
. .S NODE=$G(^PXRMD(801.41,DIEN,10,NUM,0))
. .D BLDTXTP(NODE,.CNT)
Q
;
BLDTXTP(NODE,CNT) ;
N DNODE,IEN,LABEL,NAME,TEMP,TYPE,TYPEOUT,VALUE,X
S IEN=$P(NODE,U,2) I +$G(IEN)'>0 Q
S DNODE=$G(^PXRMD(801.41,IEN,0))
S NAME=$P(DNODE,U),TYPE=$P(DNODE,U,4),TYPEOUT=$$BLDTXTT(TYPE)
S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR("Sequence:",20)_" "_$P(NODE,U)_" "_TYPEOUT_" "_NAME
I "FP"'[TYPE Q
F X=6:1:10 D
. S TEMP=$P(NODE,U,X) I TEMP="" Q
. S LABEL=$S(X=6:"Prompt Caption:",X=7:"New Line:",X=8:"Exclude From PN Text:",X=9:"Required:",1:" ")
. I $L(TEMP)>1 S VALUE=TEMP
. I $L(TEMP)=1 S VALUE=$S(TEMP=1:"Yes",1:"No")
. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=$$RJ^XLFSTR(LABEL,20)_" "_VALUE
Q
;
BLDTXTT(T) ;
N RESULT
S RESULT=$S(T="E":"Element",T="G":"Group",T="P":"Prompt",T="F":"Forced Value",T="S":"Result Group",T="T":"Result Element","R":"Dialog",1:"")
Q RESULT
;
BLDTXTF(FIND,FVPL) ;
N ABB,FNUM,GBL,IEN,NODE
S IEN=$P(FIND,";"),GBL=$P(FIND,";",2) I IEN'>0!(GBL="") Q ""
S NODE=$G(FVPL(GBL)) I NODE="" Q ""
S ABB=$P(NODE,U,4),FNUM=$P(NODE,U)
S FNAME=$$GET1^DIQ(FNUM,IEN,.01)
Q ABB_"."_FNAME
;
BLDXTMP(TYPE,DIEN,IEN,FINDVPL,ADDFVPL) ;
I TYPE="PXD(811.2," D G PRETEXT
. S ^XTMP(PXRMXTMP,"DIALOG",DIEN)=""
. S ^XTMP(PXRMXTMP,"DIALOG",DIEN,TYPE,IEN)=+$S($P($G(^PXRMD(801.41,DIEN,2)),U,5)="Y":0,1:1)
;
S ^XTMP(PXRMXTMP,"DIALOG",DIEN,TYPE,IEN)=""
PRETEXT ;
S ^TMP($J,"DLG ORDER",DIEN)=""
S ^XTMP(PXRMXTMP,"DIALOG",DIEN,"DONE")=0
;D BLDTXT(DIEN,.FINDVPL,.ADDFVPL,0,1)
Q
;
DELDATA(DIEN,FIELD,NUM) ;
N DA,DIE,DR
S DIE="^PXRMD(801.41,"
I FIELD=15 S DA=DIEN,DR="15///@"
I FIELD=18 D
.S DA(1)=DIEN,DA=NUM
.S DIE=DIE_DA(1)_",3,",DR=".01///@"
D ^DIE
Q
;
LISTCODE(DIEN,TEXT,FIND,CNT,ISADD) ;
I $P(TEXT,".")'="TX" Q
N CODES,HIST,NLINES,NODE,TDX,TPR
S NODE="PXRM POST TEXT"
K ^TMP(NODE,$J)
S NLINES=0
D TAXDISP^PXRMDTAX(FIND,0,DIEN,.NLINES,NODE,ISADD,1)
S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=""
S NLINES=0 F S NLINES=$O(^TMP(NODE,$J,NLINES)) Q:NLINES'>0 D
.S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=^TMP(NODE,$J,NLINES,0)
K ^TMP(NODE,$J)
Q
;
;
TEST(DIEN,FIND) ;
N CNT,TEXT
K ^TMP("PXRMXMZ",$J)
S CNT=0,TEXT="TX.SOMETHING"
D LISTCODE(DIEN,TEXT,FIND,.CNT,0)
S CNT=0 F S CNT=$O(^TMP("PXRMXMZ",$J,CNT)) Q:CNT'>0 D
.W !,$G(^TMP("PXRMXMZ",$J,CNT,0))
Q
PXRMP26X ;SLC/AGP - Dialog Conversion Extra routine for PXRM*2.0*26. ;01/02/2014
+1 ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
+2 QUIT
+3 ;
+4 ;build an XTMP value of dialogs that contains Taxonomy, ICD9 codes, and/or CPT codes.
+5 ;if ICD9 or CPT deletes the values from file 801.41
BLDLIST(PXRMSKIP) ;
+1 KILL ^TMP($JOB,"DLG FIND"),^TMP($JOB,"DLG ORDER")
+2 DO MES^XPDUTL("Building lists of dialogs to update")
+3 DO BLDDLGTM^PXRMSTS("DLG FIND")
+4 NEW ADD,ADDFNDS,ADDFVPL,CNT,DIEN,FIND,FINDFVPL,IEN,NAME,NUM,TEMP,TYPE
+5 DO BLDRLIST^PXRMVPTR(801.41,15,.FINDFVPL)
+6 DO BLDRLIST^PXRMVPTR(801.4118,.01,.ADDFVPL)
+7 KILL ^TMP("PXRMXMZ",$JOB)
+8 SET ^TMP("PXRMXMZ",$JOB,1,0)="Dialog pre-conversion report:"
+9 FOR TYPE="ICD9(","ICPT(","PXD(811.2,"
Begin DoDot:1
+10 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,"DLG FIND",TYPE,IEN))
IF IEN'>0
QUIT
Begin DoDot:2
+11 SET DIEN=0
FOR
SET DIEN=$ORDER(^TMP($JOB,"DLG FIND",TYPE,IEN,DIEN))
IF DIEN'>0
QUIT
Begin DoDot:3
+12 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+13 ;If field is set assume conversion has already happen.
+14 IF TYPE="PXD(811.2,"
IF $PIECE($GET(^PXRMD(801.41,DIEN,"TAX")),U)'=""
QUIT
+15 ;If taxonomy is assigned as an additional finding assume conversion has already happen
+16 IF TYPE="PXD(811.2,"
IF $DATA(^TMP($JOB,"DLG FIND",TYPE,IEN,DIEN,18))
QUIT
+17 IF '$DATA(PXRMSKIP(NAME))
DO BLDXTMP(TYPE,DIEN,IEN,.FINDFVPL,.ADDFVPL)
+18 IF TYPE="PXD(811.2,"
QUIT
+19 ;
+20 FOR FIND=15,18
Begin DoDot:4
+21 IF FIND=15
IF $DATA(^TMP($JOB,"DLG FIND",TYPE,IEN,DIEN,FIND))
SET TEMP(15,DIEN)=""
QUIT
+22 SET NUM=0
FOR
SET NUM=$ORDER(^TMP($JOB,"DLG FIND",TYPE,IEN,DIEN,FIND,NUM))
IF NUM'>0
QUIT
SET TEMP(18,DIEN,NUM)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 IF $DATA(^TMP($JOB,"DLG ORDER"))
SET DIEN=0
FOR
SET DIEN=$ORDER(^TMP($JOB,"DLG ORDER",DIEN))
IF DIEN'>0
QUIT
DO BLDTXT(DIEN,.FINDFVPL,.ADDFVPL,0,1)
+24 IF '$DATA(TEMP)
GOTO BLDLISTX
+25 FOR FIND=15,18
Begin DoDot:1
+26 SET DIEN=""
FOR
SET DIEN=$ORDER(TEMP(FIND,DIEN))
IF DIEN'>0
QUIT
Begin DoDot:2
+27 IF FIND=15
DO DELDATA(DIEN,FIND)
QUIT
+28 SET NUM=""
FOR
SET NUM=$ORDER(TEMP(FIND,DIEN,NUM))
IF NUM'>0
QUIT
DO DELDATA(DIEN,FIND,NUM)
End DoDot:2
End DoDot:1
BLDLISTX ;
+1 IF $ORDER(^TMP("PXRMXMZ",$JOB,""),-1)>1
DO SEND^PXRMMSG("PXRMXMZ","Clinical Reminder Patch 26 Pre-conversion dialog.")
+2 KILL ^TMP("PXRMXMZ",$JOB)
+3 QUIT
+4 ;
BLDTXT(DIEN,FINDFVPL,ADDFVPL,TAXNEEDS,PRE) ;
+1 NEW ADD,CNT,CPTTEXT,NAME,NODE,NUM,POVTEXT,RES,TEXT,TEMP,TSEL
+2 SET CNT=+$ORDER(^TMP("PXRMXMZ",$JOB,""),-1)
+3 IF CNT>0
SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=" "
+4 SET NODE=$GET(^PXRMD(801.41,DIEN,0))
+5 SET NAME=$PIECE(NODE,U)
+6 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=NAME
+7 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="======================================================="
+8 ;
+9 SET TEMP=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)
+10 ;S TEMP=$P($G(^PXRMD(801.41,DIEN,1)),U,5),RES=+$P($G(^PXRMD(801.41,DIEN,1)),U,3)
+11 IF TAXNEEDS=1
Begin DoDot:1
+12 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="PREVIOUSLY THE DIALOG WAS SET TO BOTH CURRENT AND HISTORICAL ENCOUNTERS."
+13 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="DIALOG IS NOW SET TO CURRENT ENCOUNTER ONLY."
+14 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="REVIEW THE DIALOG BEFORE USING IN CPRS."
End DoDot:1
+15 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=$$RJ^XLFSTR("Resolution Type:",25)_" "_$$GET1^DIQ(801.41,DIEN,13)
+16 IF TEMP'=""
Begin DoDot:1
+17 SET TEXT=$$BLDTXTF(TEMP,.FINDFVPL)
+18 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=$$RJ^XLFSTR("Finding Item:",25)_" "_TEXT
+19 DO LISTCODE(DIEN,TEXT,TEMP,.CNT,0)
+20 SET TSEL=$$GET1^DIQ(801.41,DIEN,123)
+21 IF PRE=0
SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=$$RJ^XLFSTR("Taxonomy Pick List:",25)_" "_$GET(TSEL)
+22 SET CPTTEXT=""
SET POVTEXT=""
+23 IF "AD"[TSEL
SET POVTEXT=$$GET1^DIQ(801.41,DIEN,141)
+24 IF "AP"[TSEL
SET CPTTEXT=$$GET1^DIQ(801.41,DIEN,142)
+25 IF $GET(POVTEXT)'=""
SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=$$RJ^XLFSTR("Diagnosis Header:",25)_" "_POVTEXT
+26 IF $GET(CPTTEXT)'=""
SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=$$RJ^XLFSTR("Procedure Header:",25)_" "_CPTTEXT
End DoDot:1
+27 ;
+28 IF $DATA(^PXRMD(801.41,DIEN,3,0))
Begin DoDot:1
+29 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=" "
+30 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=$$RJ^XLFSTR("Additional Finding Items:",25)
+31 SET ADD=""
FOR
SET ADD=$ORDER(^PXRMD(801.41,DIEN,3,"B",ADD))
IF ADD=""
QUIT
Begin DoDot:2
+32 SET TEXT=$$BLDTXTF(ADD,.ADDFVPL)
+33 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=" Items: "_TEXT
+34 DO LISTCODE(DIEN,TEXT,ADD,.CNT,1)
End DoDot:2
End DoDot:1
+35 IF $PIECE($GET(^PXRMD(801.41,DIEN,2)),U,5)=1
Begin DoDot:1
+36 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=" "
+37 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="Suppress All Prompts: Yes"
End DoDot:1
+38 IF $DATA(^PXRMD(801.41,DIEN,10))
Begin DoDot:1
+39 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=" "
+40 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=$$RJ^XLFSTR("Components:",15)
+41 SET NUM=0
FOR
SET NUM=$ORDER(^PXRMD(801.41,DIEN,10,NUM))
IF NUM'>0
QUIT
Begin DoDot:2
+42 SET NODE=$GET(^PXRMD(801.41,DIEN,10,NUM,0))
+43 DO BLDTXTP(NODE,.CNT)
End DoDot:2
End DoDot:1
+44 QUIT
+45 ;
BLDTXTP(NODE,CNT) ;
+1 NEW DNODE,IEN,LABEL,NAME,TEMP,TYPE,TYPEOUT,VALUE,X
+2 SET IEN=$PIECE(NODE,U,2)
IF +$GET(IEN)'>0
QUIT
+3 SET DNODE=$GET(^PXRMD(801.41,IEN,0))
+4 SET NAME=$PIECE(DNODE,U)
SET TYPE=$PIECE(DNODE,U,4)
SET TYPEOUT=$$BLDTXTT(TYPE)
+5 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=$$RJ^XLFSTR("Sequence:",20)_" "_$PIECE(NODE,U)_" "_TYPEOUT_" "_NAME
+6 IF "FP"'[TYPE
QUIT
+7 FOR X=6:1:10
Begin DoDot:1
+8 SET TEMP=$PIECE(NODE,U,X)
IF TEMP=""
QUIT
+9 SET LABEL=$SELECT(X=6:"Prompt Caption:",X=7:"New Line:",X=8:"Exclude From PN Text:",X=9:"Required:",1:" ")
+10 IF $LENGTH(TEMP)>1
SET VALUE=TEMP
+11 IF $LENGTH(TEMP)=1
SET VALUE=$SELECT(TEMP=1:"Yes",1:"No")
+12 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=$$RJ^XLFSTR(LABEL,20)_" "_VALUE
End DoDot:1
+13 QUIT
+14 ;
BLDTXTT(T) ;
+1 NEW RESULT
+2 SET RESULT=$SELECT(T="E":"Element",T="G":"Group",T="P":"Prompt",T="F":"Forced Value",T="S":"Result Group",T="T":"Result Element","R":"Dialog",1:"")
+3 QUIT RESULT
+4 ;
BLDTXTF(FIND,FVPL) ;
+1 NEW ABB,FNUM,GBL,IEN,NODE
+2 SET IEN=$PIECE(FIND,";")
SET GBL=$PIECE(FIND,";",2)
IF IEN'>0!(GBL="")
QUIT ""
+3 SET NODE=$GET(FVPL(GBL))
IF NODE=""
QUIT ""
+4 SET ABB=$PIECE(NODE,U,4)
SET FNUM=$PIECE(NODE,U)
+5 SET FNAME=$$GET1^DIQ(FNUM,IEN,.01)
+6 QUIT ABB_"."_FNAME
+7 ;
BLDXTMP(TYPE,DIEN,IEN,FINDVPL,ADDFVPL) ;
+1 IF TYPE="PXD(811.2,"
Begin DoDot:1
+2 SET ^XTMP(PXRMXTMP,"DIALOG",DIEN)=""
+3 SET ^XTMP(PXRMXTMP,"DIALOG",DIEN,TYPE,IEN)=+$SELECT($PIECE($GET(^PXRMD(801.41,DIEN,2)),U,5)="Y":0,1:1)
End DoDot:1
GOTO PRETEXT
+4 ;
+5 SET ^XTMP(PXRMXTMP,"DIALOG",DIEN,TYPE,IEN)=""
PRETEXT ;
+1 SET ^TMP($JOB,"DLG ORDER",DIEN)=""
+2 SET ^XTMP(PXRMXTMP,"DIALOG",DIEN,"DONE")=0
+3 ;D BLDTXT(DIEN,.FINDVPL,.ADDFVPL,0,1)
+4 QUIT
+5 ;
DELDATA(DIEN,FIELD,NUM) ;
+1 NEW DA,DIE,DR
+2 SET DIE="^PXRMD(801.41,"
+3 IF FIELD=15
SET DA=DIEN
SET DR="15///@"
+4 IF FIELD=18
Begin DoDot:1
+5 SET DA(1)=DIEN
SET DA=NUM
+6 SET DIE=DIE_DA(1)_",3,"
SET DR=".01///@"
End DoDot:1
+7 DO ^DIE
+8 QUIT
+9 ;
LISTCODE(DIEN,TEXT,FIND,CNT,ISADD) ;
+1 IF $PIECE(TEXT,".")'="TX"
QUIT
+2 NEW CODES,HIST,NLINES,NODE,TDX,TPR
+3 SET NODE="PXRM POST TEXT"
+4 KILL ^TMP(NODE,$JOB)
+5 SET NLINES=0
+6 DO TAXDISP^PXRMDTAX(FIND,0,DIEN,.NLINES,NODE,ISADD,1)
+7 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=""
+8 SET NLINES=0
FOR
SET NLINES=$ORDER(^TMP(NODE,$JOB,NLINES))
IF NLINES'>0
QUIT
Begin DoDot:1
+9 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=^TMP(NODE,$JOB,NLINES,0)
End DoDot:1
+10 KILL ^TMP(NODE,$JOB)
+11 QUIT
+12 ;
+13 ;
TEST(DIEN,FIND) ;
+1 NEW CNT,TEXT
+2 KILL ^TMP("PXRMXMZ",$JOB)
+3 SET CNT=0
SET TEXT="TX.SOMETHING"
+4 DO LISTCODE(DIEN,TEXT,FIND,.CNT,0)
+5 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("PXRMXMZ",$JOB,CNT))
IF CNT'>0
QUIT
Begin DoDot:1
+6 WRITE !,$GET(^TMP("PXRMXMZ",$JOB,CNT,0))
End DoDot:1
+7 QUIT
