PXRMEXU4 ;SLC/PJH,PKR - Reminder Exchange #4, dialog changes. ;Dec 07, 2021@12:24
;;2.0;CLINICAL REMINDERS;**6,12,22,26,45,71,65**;Feb 04, 2005;Build 438
;
Q
BLCONV(FDA) ;
N BLIENS,ACT,IEN,IENS,LAST,TERM,SEQ,STATUS,REP
S IENS=$O(FDA(801.44,"")) Q:IENS=""
S IEN=$P(IENS,",",2)_","
I $G(FDA(801.41,IEN,116))="" Q
I $G(FDA(801.41,IEN,117))="" Q
S TERM="RT."_FDA(801.41,IEN,116)
S STATUS=$G(FDA(801.41,IEN,117))
S REP=$S($G(FDA(801.41,IEN,118))'="":$G(FDA(801.41,IEN,118)),1:"")
S ACT=$S(REP'="":"REPLACE",1:"HIDE")
K FDA(801.41,IEN,116),FDA(801.41,IEN,117),FDA(801.41,IEN,118)
S SEQ=1
S LAST=$P($P(IENS,"+",2),",")
S BLIENS=1+LAST_","_IEN
S FDA(801.41143,"+"_BLIENS,.01)=1
S FDA(801.41143,"+"_BLIENS,1)=TERM
S FDA(801.41143,"+"_BLIENS,2)=STATUS
S FDA(801.41143,"+"_BLIENS,3)=ACT
I REP'="" S FDA(801.41143,"+"_BLIENS,4)=REP
Q
;
BLDCONV1(FDA) ;
N IENS
S IENS=""
F S IENS=$O(FDA(801.41143,IENS)) Q:IENS="" D
.I $P(FDA(801.41143,IENS,1),".")="TM" D
..S FDA(801.41143,IENS,1)="RT."_$P(FDA(801.41143,IENS,1),".",2)
Q
;
VIMMCONV(FDA,IENS,HASSKT,HASIMM) ;
I HASSKT=0,HASIMM=0 Q
N FIND,FINDINGS,TFINDS
I HASSKT,HASIMM S FDA(801.41,IENS,3)="DISABLE AND SEND MESSAGE"
S FIND=$G(FDA(801.41,IENS,15))
I FIND'["ST.",FIND'["IM." K FDA(801.41,IENS,15)
;loop through additional findings
S FIND="" F S FIND=$O(FDA(801.4118,FIND)) Q:FIND="" D
. S FINDINGS=$G(FDA(801.4118,FIND,.01))
. I FINDINGS["ST."!(FINDINGS["IM.")!(FINDINGS["TX.") Q
. S TFINDS(FIND)=""
.;kill off additional findings that are codes
S FIND="" F S FIND=$O(TFINDS(FIND)) Q:FIND="" D
.K FDA(801.4118,FIND)
Q
;
;===============================================
DLG(FDA,NAMECHG) ;Check the dialog for renamed entries, called by
;silent installer. KIDSDONE is newed in INSDLG^PXRMEXSI.
N ABBR,ACTION,ALIST,DNAM,HASIMM,HASSKT,IEN,IENS,ISACT,FILENUM,FINDING,NEWNAM,OFINDING
N RESULT,RRG,SRC,TEMP,TEXT,TIENS,TYPE,WP
;
S HASIMM=0,HASSKT=0
;
S IENS=$O(FDA(801.41,""))
;Definition .01
S (PT01,DNAM)=FDA(801.41,IENS,.01)
I $D(NAMECHG(801.41,PT01)) D
.S (FDA(801.41,IENS,.01),DNAM)=NAMECHG(801.41,PT01)
;
;Build list of finding types
D BLDALIST^PXRMVPTR(801.4118,.01,.ALIST)
;Plus field 15 files
S ALIST("MH")=601.71,ALIST("TX")=811.2
S ALIST("WH")=790.404
;Plus field 17 file
S ALIST("OI")=101.43
;
;Process SOURCE REMINDER
S SRC=$G(FDA(801.41,IENS,2))
I SRC]"" D
.S IEN=$$EXISTS^PXRMEXIU(811.9,SRC)
.I IEN=0 K FDA(801.41,IENS,2)
;
;Clear RESULT if not defined
S RESULT=$G(FDA(801.41,IENS,55))
I RESULT]"" D
.S IEN=$$EXISTS^PXRMEXIU(801.41,RESULT)
.I IEN=0 K FDA(801.41,IENS,55)
;
F TYPE="OI","FI","AF","DC","RG" D Q:+$G(PXRMDONE)=1
.N FIELD,NUM
.I TYPE="OI" S FIELD=17,NUM=801.41
.I TYPE="FI" S FIELD=15,NUM=801.41
.I TYPE="AF" S FIELD=.01,NUM=801.4118
.I TYPE="DC" S FIELD=2,NUM=801.412
.I TYPE="RG" S FIELD=.01,NUM=801.41121
.I TYPE="FI" D TAXCONV(.FDA,IENS)
.I NUM=801.4118!(NUM=801.412)!(NUM=801.41121) D
..S TIENS="",ACTION="" F S TIENS=$O(FDA(NUM,TIENS)) Q:TIENS=""!(PXRMDONE=1) D
...I (TYPE="AF") D FINDINGS(TIENS,NUM,FIELD,TYPE,.NAMECHG,.ACTION,.FDA,.PXRMDONE)
...I FDA(NUM,TIENS,.01)["ST." S HASSKT=1 Q
...I FDA(NUM,TIENS,.01)["IM." S HASIMM=1
...I TYPE'="AF" D COMPS(TIENS,NUM,FIELD,TYPE,.NAMECHG,.ACTION,.FDA,.PXRMDONE)
.I NUM=801.41 D
..D FINDINGS(IENS,NUM,FIELD,TYPE,.NAMECHG,.ACTION,.FDA,.PXRMDONE)
..I $G(FDA(NUM,IENS,15))["ST." S HASSKT=1
..I $G(FDA(NUM,IENS,15))["IM." S HASIMM=1
;
;Look for replacements of TIU templates.
I $D(NAMECHG(8927.1)) D
.S WP=$G(FDA(801.41,IENS,25))
.I WP'="" D TIURPL("{FLD:",WP,.NAMECHG,8927.1)
.S WP=$G(FDA(801.41,IENS,35))
;
D BLCONV(.FDA)
I $D(FDA(801.41143)) D BLDCONV1(.FDA)
D VIMMCONV(.FDA,IENS,HASSKT,HASIMM)
Q
;
;===============================================
;Convert ICD9 codes to `ien format
ICD9(CODE) ;
N IEN
S IEN=$$FIND1^DIC(80,"","AMX",$P(CODE,".",2,99))
I 'IEN Q ""
Q IEN
;
;
COMPS(IENS,NUM,FIELD,TYPE,NAMECHG,ACTION,FDA,PXRMDONE) ;
N FILENUM,IEN,NAMECHG,NEWNAME,PT01,TEXT
F S IENS=$O(FDA(NUM,IENS)) Q:IENS="" D I ACTION="Q" K FDA S PXRMDONE=1 Q
. S PT01=$G(FDA(NUM,IENS,FIELD)) Q:PT01=""
. S FILENUM=801.41,NEWNAM=$G(NAMECHG(FILENUM,PT01))
.I NEWNAM'="" D
.. S FDA(NUM,IENS,2)=NEWNAM,PT01=NEWNAM
.S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
.I IEN=0 D
..;Get replacement
.. N DIC,DIR,DUOUT,MSG,X,Y
.. S MSG(1)=" "
.. S MSG(2)=$S(TYPE="RG":"RESULT GROUP",1:"COMPONENT DIALOG")_" entry "_PT01_" does not exist."
.. D MES^XPDUTL(.MSG)
.. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
.. I ACTION="S" S ACTION="Q"
.. I ACTION="Q" Q
.. I ACTION="D" K FDA(NUM,IENS) Q
.. S DIC=FILENUM
.. S DIC(0)="AEMNQ"
.. S DIC("S")="I ""S""[$P(^PXRMD(801.41,Y,0),U,4)"
.. S Y=-1
.. F Q:+Y'=-1 D
...;If this is being called during a KIDS install we need echoing on.
... I $D(XPDNM) X ^%ZOSF("EON")
... D ^DIC
... I $D(XPDNM) X ^%ZOSF("EOFF")
... I $D(DUOUT) S Y="" Q
... I Y=-1 D BMES^XPDUTL("You must input a replacement!")
.. I Y="" S ACTION="Q" Q
.. I Y'="" S FDA(NUM,IENS,.01)=$P(Y,U,2)
Q
;
FINDINGS(IENS,NUM,FIELD,TYPE,NAMECHG,ACTION,FDA,PXRMDONE) ;
N ABBR,FILENUM,ITEM,IEN,NAMECHG,ORIG,SET,TEXT
S (ITEM,ORIG)=$G(FDA(NUM,IENS,FIELD)),ACTION=""
I ITEM'="" D I ACTION="Q" K FDA S PXRMDONE=1 Q
.S TEXT=""
.S ABBR=$S(TYPE="OI":"OI",1:$P(ITEM,".",1))
.S PT01=$S(TYPE="OI":ITEM,1:$P(ITEM,".",2))
.S FILENUM=$P(ALIST(ABBR),U)
.I $D(NAMECHG(FILENUM,PT01)) D
..S ITEM=$S(TYPE="OI":NAMECHG(FILENUM,PT01),1:ABBR_"."_NAMECHG(FILENUM,PT01))
..S FDA(NUM,IENS,FIELD)=ITEM
.S IEN=$S(TYPE="OI":+$$VFIND1^PXRMEXIU(ABBR_"."_ITEM,.ALIST),1:+$$VFIND1^PXRMEXIU(ITEM,.ALIST))
.I IEN>0 S TEMP=$$VDLGFIND^PXRMEXIU(ABBR,IEN,.ALIST) I TEMP<1 D
..S IEN=0
..S TEXT=$S(TYPE="OI":"ORDERABLE ITEM",TYPE="AF":"ADDITIONAL FINDING",1:"FINDING")_" entry "_ITEM_" "_$S(TEMP=0:"is inactive.",1:" does not have codes marked to be used in a dialog.")
.I IEN>0 S FDA(NUM,IENS,FIELD)=$S(TYPE="OI":"`"_IEN,1:ABBR_".`"_IEN)
.I IEN=0 D
..S SET=0
..;I $D(^TMP($J,"PXRM FINDING REPLACE",NUM,FIELD,ORIG)) D
..;.S ITEM=$G(^TMP($J,"PXRM FINDING REPLACE",NUM,FIELD,ORIG)) I ITEM="" Q
..I $D(^TMP($J,"PXRM FINDING REPLACE",ORIG)) D
...S ITEM=$G(^TMP($J,"PXRM FINDING REPLACE",ORIG)) I ITEM="" Q
...S FDA(NUM,IENS,FIELD)=ITEM,SET=1
..I SET=1 Q
..I TEXT="" S TEXT=$S(TYPE="OI":"ORDERABLE ITEM",TYPE="AF":"ADDITIONAL FINDING",1:"FINDING")_" entry "_ITEM_" does not exist."
..;Get replacement
..N DIC,DIR,DUOUT,MSG,X,Y
..S MSG(1)=" "
..S MSG(2)=TEXT
..D MES^XPDUTL(.MSG)
..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q"
..I ACTION="Q" Q
..I ACTION="D" K FDA(NUM,IENS,FIELD) Q
..S DIC=FILENUM
..S DIC(0)="AEMNQ"
..S DIC("S")="I $$FILESCR^PXRMDLG6(Y,FILENUM)=1"
..S Y=-1
..F Q:+Y'=-1 D
...;If this is being called during a KIDS install we need echoing on.
...I $D(XPDNM) X ^%ZOSF("EON")
...D ^DIC
...I $D(XPDNM) X ^%ZOSF("EOFF")
...;If this is being called during a KIDS install we need echoing on.
...I $D(DUOUT) S Y="" Q
...I Y=-1 D BMES^XPDUTL("You must input a replacement!")
..I Y="" S ACTION="Q" Q
..S ITEM=$S(TYPE="OI":$P(Y,U,2),1:ABBR_"."_$P(Y,U,2))
..S FDA(NUM,IENS,FIELD)=ITEM
.;Save the finding information for the history.
.I ITEM'=ORIG D
.. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),ORIG)=ITEM
.. S ^TMP($J,"PXRM FINDING REPLACE",ORIG)=ITEM
Q
;
SETWARN(TEXT) ;
S TEXT(1)="PREVIOUSLY THE DIALOG WAS SET TO BOTH CURRENT AND HISTORICAL ENCOUNTERS."
S TEXT(2)="DIALOG IS NOW SET TO CURRENT ENCOUNTER ONLY."
S TEXT(3)="REVIEW THE DIALOG BEFORE USING IN CPRS."
Q
;
TAXARRAY(FINDING,CNT,ARRAY) ;
; add to code list to create a new taxonomy
N CODE,CODESYS,CODESYSN,IEN
S CODESYS=$P(FINDING,"."),CODE=$P(FINDING,".",2,99)
I $P(CODESYS,".")'["ICD9",$P(CODESYS,".")'["CPT" Q
S CODESYSN=$S(CODESYS[9:"ICD",1:"CPT")
S IEN=$$EXISTS^PXRMEXIU($S(CODESYSN="ICD":80,1:81),CODE)
S CNT=CNT+1,ARRAY("CODE",CODESYSN,IEN)="I"_U_1
Q
;
TAXCONV(FDA,IENS) ;
; FINDING ITEM FDA(801.41,IENS,15)
; ADDITIONAL FINDINGS FDA(801.4118,IENS)
N ADDIENS,ARRAY,CNT,ERROR,FINDING,FINDS,ISFNDFLD,LAST,NAME,OCNT,TAX,TAXNAME,TEMP,TFINDS
S ISFNDFLD=0,CNT=0
;if finding is taxonomy add the correct fields to the element
S FINDING=$G(FDA(801.41,IENS,15))
I $P(FINDING,".")="TX" D TAXCONV1(.FDA,IENS,FINDING) Q
;
I FINDING'="" D
.D TAXARRAY(FINDING,.CNT,.ARRAY)
.;if array defined then finding has a code kill the node off.
.I $D(ARRAY) S ISFNDFLD=1 K FDA(801.41,IENS,15)
;loop through additional findings
S FINDS="" F S FINDS=$O(FDA(801.4118,FINDS)) Q:FINDS="" D
. S FINDING=FDA(801.4118,FINDS,.01)
. S OCNT=CNT D TAXARRAY(FINDING,.CNT,.ARRAY) I CNT>OCNT S TFINDS(FINDS)=""
;kill off additional findings that are codes
S ADDIENS=""
S FINDS="" F S FINDS=$O(TFINDS(FINDS)) Q:FINDS="" D
.K FDA(801.4118,FINDS)
.I ADDIENS="" S ADDIENS=FINDS
I '$D(ARRAY) Q
;build values to crate a new taxonomy
S NAME=$G(FDA(801.41,IENS,.01))
S TEMP=$$RTAXNAME^PXRMDUTL(NAME)
S ARRAY("NAME")=TEMP
S ARRAY("COUNT")=CNT
S ARRAY("CLASS")=$G(FDA(801.41,IENS,100))
S ARRAY("SOURCE")="Exchange installed of dialog "_NAME
;create new taxonomy API
S TAX=$$CRETAX^PXRMTXIM("E",.ARRAY,.ERROR)
I $D(ERROR) D Q
.I $G(TAX)=0 D BMES^XPDUTL("ERROR: Taxonomy could not be created for dialog "_NAME_".") H 1 Q
.D BMES^XPDUTL("ERROR: failed to add all the codes to the Taxonomy "_TEMP_". The codes that could not be added are:")
.D BMES^XPDUTL(.ERROR)
.H 1
S TAXNAME=$P($G(^PXD(811.2,TAX,0)),U)
D BMES^XPDUTL("Taxonomy "_TAXNAME_" created") H 1
I ISFNDFLD=1 D Q
.S FDA(801.41,IENS,15)="TX.`"_TAX
.S FDA(801.41,IENS,123)="NO PICK LIST"
S FINDS=$O(FDA(801.4118,""),-1)
S LAST=$O(FDA(801.44,""),-1) I LAST="" Q
S TEMP=$P($P(LAST,"+",2),",")+1,TEMP="+"_TEMP
S FDA(801.4118,ADDIENS,.01)="TX.`"_TAX
Q
;
TAXCONV1(FDA,IENS,FINDING) ;
N CNT,CPTSTATUS,DEFAULT,DNUM,ENC,ENCTYPE,IEN,NODE,NODECNT
N PROMPTS,POVSTATUS,START,TAX,TEXT,TAXIEN,TDX,TPR,TYPE,VALUE,X
;if taxonomy fields defined then quit
I ($G(FDA(801.41,IENS,123))'="") Q
;if group set to not display a pick list.
I FDA(801.41,IENS,4)["group" S FDA(801.41,IENS,123)="N" Q
S TAX=$P(FINDING,".",2)
S FDA(801.41,IENS,123)="ALL"
;
S TAXIEN=$O(^PXD(811.2,"B",TAX,"")) I TAXIEN'>0 Q
;determine Taxonomy Type
S TDX=$$TOK^PXRMDTAX(TAXIEN,"POV")
S TPR=$$TOK^PXRMDTAX(TAXIEN,"CPT")
D SETWARN(.TEXT)
;build default array for taxonomy
S CPTSTATUS=$$GETSTAT^PXRMDTAX("CPT"),POVSTATUS=$$GETSTAT^PXRMDTAX("POV")
I TDX=1 D GETTAXDF^PXRMDTAX(.DEFAULT,"POV",$S(POVSTATUS=2:1,1:0))
I TPR=1 D GETTAXDF^PXRMDTAX(.DEFAULT,"CPT",$S(CPTSTATUS=2:1,1:0))
I TDX,TPR D
.I CPTSTATUS=POVSTATUS,POVSTATUS=2 S FDA(801.41,IENS,13)="2" Q
.S FDA(801.41,IENS,13)="@"
.I CPTSTATUS=0!(POVSTATUS=0) D BMES^XPDUTL(.TEXT)
I TDX,TPR=0 D
.I POVSTATUS=2 S FDA(801.41,IENS,13)="2" Q
.S FDA(801.41,IENS,13)="@" I POVSTATUS=0 D BMES^XPDUTL(.TEXT)
I TDX=0,TPR=1 D
.I CPTSTATUS=2 S FDA(801.41,IENS,13)="2" Q
.S FDA(801.41,IENS,13)="@" I CPTSTATUS=0 D BMES^XPDUTL(.TEXT)
S NODECNT=$O(FDA(801.44,""),-1) I NODECNT="" Q
;
;build encounter tax field
F TYPE="POV","CPT" D
.I TYPE="POV",TDX=0 Q
.I TYPE="CPT",TPR=0 Q
.I TYPE="POV" S X=141
.I TYPE="CPT" S X=142
.S VALUE=$$ADDTAXF1^PXRMDTAX(TYPE,.DEFAULT)
.S FDA(801.41,IENS,X)=VALUE
.;
.;build prompt array from default list
.S TYPE="" F S TYPE=$O(DEFAULT(TYPE)) Q:TYPE="" D
..;I TPR=0,CODE="CPT" Q
..;I TDX=0,CODE="POV" Q
..S CNT=0 F S CNT=$O(DEFAULT(TYPE,"ADDFIND",CNT)) Q:CNT'>0 D
...S NODE=DEFAULT(TYPE,"ADDFIND",CNT),IEN=$P(NODE,U)
...I $D(PROMPTS(IEN))>0 I $L(PROMPTS(IEN),U)<$L(NODE,U) S PROMPTS(IEN)=NODE
...S PROMPTS(IEN)=NODE
;
I $G(FDA(801.41,IENS,122))="YES" K FDA(801.41,IENS,122) Q
I $D(FDA(801.412)) Q
;
;add prompts to the dialog element.
S START=0,IEN=0,CNT=0,DNUM=0
S IEN=0,CNT=0 F S IEN=$O(PROMPTS(IEN)) Q:IEN'>0 D
.S START=START+1,DNUM=DNUM+1
.S NAME=$P($G(^PXRMD(801.41,IEN,0)),U)
.S NODE=PROMPTS(IEN),CNT=$L(NODE,U)
.I $P(NODE,U,3)>0 Q
.S NODECNT=NODECNT+1
.S FDA(801.412,"+"_NODECNT_","_IENS,.01)=START
.S FDA(801.412,"+"_NODECNT_","_IENS,2)="`"_IEN
.I CNT=1 Q
.F NUM=2:1:CNT D
..S VALUE=$P(NODE,U,NUM) I $G(VALUE)="" Q
..S FIELD=$S(NUM=2:9,NUM=4:.01,NUM=5:6,NUM=6:7,NUM=7:8,1:"") I $G(FIELD)="" Q
..I FIELD>6 S VALUE=$S(VALUE=1:"YES",1:"NO")
..S FDA(801.412,"+"_NODECNT_","_IENS,FIELD)=VALUE
Q
;
;===============================================
TIURPL(SRCH,WP,NAMEGHC,FILENUM) ;Replace TIU templates whose names have
;changed.
N IND,RS,TEXT,TS,TYPE
I FILENUM=8927.1 S TYPE="TIU TEMPLATE"
E S TYPE="TIU OBJECT"
S IND=1
F S TEXT=$G(@WP@(IND)) Q:TEXT="" D
.I TEXT[SRCH D
..S TS=""
..F S TS=$O(NAMECHG(FILENUM,TS)) Q:TS="" D
...S RS=NAMECHG(FILENUM,TS) Q:TEXT'[TS
...S @WP@(IND)=$$STRREP^PXRMUTIL(TEXT,TS,RS)
...;Save the replacement information for the history.
...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS)=RS
...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS,DNAM)=""
.S IND=IND+1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXU4 13247 printed Dec 13, 2024@01:45:20 Page 2
PXRMEXU4 ;SLC/PJH,PKR - Reminder Exchange #4, dialog changes. ;Dec 07, 2021@12:24
+1 ;;2.0;CLINICAL REMINDERS;**6,12,22,26,45,71,65**;Feb 04, 2005;Build 438
+2 ;
+3 QUIT
BLCONV(FDA) ;
+1 NEW BLIENS,ACT,IEN,IENS,LAST,TERM,SEQ,STATUS,REP
+2 SET IENS=$ORDER(FDA(801.44,""))
if IENS=""
QUIT
+3 SET IEN=$PIECE(IENS,",",2)_","
+4 IF $GET(FDA(801.41,IEN,116))=""
QUIT
+5 IF $GET(FDA(801.41,IEN,117))=""
QUIT
+6 SET TERM="RT."_FDA(801.41,IEN,116)
+7 SET STATUS=$GET(FDA(801.41,IEN,117))
+8 SET REP=$SELECT($GET(FDA(801.41,IEN,118))'="":$GET(FDA(801.41,IEN,118)),1:"")
+9 SET ACT=$SELECT(REP'="":"REPLACE",1:"HIDE")
+10 KILL FDA(801.41,IEN,116),FDA(801.41,IEN,117),FDA(801.41,IEN,118)
+11 SET SEQ=1
+12 SET LAST=$PIECE($PIECE(IENS,"+",2),",")
+13 SET BLIENS=1+LAST_","_IEN
+14 SET FDA(801.41143,"+"_BLIENS,.01)=1
+15 SET FDA(801.41143,"+"_BLIENS,1)=TERM
+16 SET FDA(801.41143,"+"_BLIENS,2)=STATUS
+17 SET FDA(801.41143,"+"_BLIENS,3)=ACT
+18 IF REP'=""
SET FDA(801.41143,"+"_BLIENS,4)=REP
+19 QUIT
+20 ;
BLDCONV1(FDA) ;
+1 NEW IENS
+2 SET IENS=""
+3 FOR
SET IENS=$ORDER(FDA(801.41143,IENS))
if IENS=""
QUIT
Begin DoDot:1
+4 IF $PIECE(FDA(801.41143,IENS,1),".")="TM"
Begin DoDot:2
+5 SET FDA(801.41143,IENS,1)="RT."_$PIECE(FDA(801.41143,IENS,1),".",2)
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
VIMMCONV(FDA,IENS,HASSKT,HASIMM) ;
+1 IF HASSKT=0
IF HASIMM=0
QUIT
+2 NEW FIND,FINDINGS,TFINDS
+3 IF HASSKT
IF HASIMM
SET FDA(801.41,IENS,3)="DISABLE AND SEND MESSAGE"
+4 SET FIND=$GET(FDA(801.41,IENS,15))
+5 IF FIND'["ST."
IF FIND'["IM."
KILL FDA(801.41,IENS,15)
+6 ;loop through additional findings
+7 SET FIND=""
FOR
SET FIND=$ORDER(FDA(801.4118,FIND))
if FIND=""
QUIT
Begin DoDot:1
+8 SET FINDINGS=$GET(FDA(801.4118,FIND,.01))
+9 IF FINDINGS["ST."!(FINDINGS["IM.")!(FINDINGS["TX.")
QUIT
+10 SET TFINDS(FIND)=""
+11 ;kill off additional findings that are codes
End DoDot:1
+12 SET FIND=""
FOR
SET FIND=$ORDER(TFINDS(FIND))
if FIND=""
QUIT
Begin DoDot:1
+13 KILL FDA(801.4118,FIND)
End DoDot:1
+14 QUIT
+15 ;
+16 ;===============================================
DLG(FDA,NAMECHG) ;Check the dialog for renamed entries, called by
+1 ;silent installer. KIDSDONE is newed in INSDLG^PXRMEXSI.
+2 NEW ABBR,ACTION,ALIST,DNAM,HASIMM,HASSKT,IEN,IENS,ISACT,FILENUM,FINDING,NEWNAM,OFINDING
+3 NEW RESULT,RRG,SRC,TEMP,TEXT,TIENS,TYPE,WP
+4 ;
+5 SET HASIMM=0
SET HASSKT=0
+6 ;
+7 SET IENS=$ORDER(FDA(801.41,""))
+8 ;Definition .01
+9 SET (PT01,DNAM)=FDA(801.41,IENS,.01)
+10 IF $DATA(NAMECHG(801.41,PT01))
Begin DoDot:1
+11 SET (FDA(801.41,IENS,.01),DNAM)=NAMECHG(801.41,PT01)
End DoDot:1
+12 ;
+13 ;Build list of finding types
+14 DO BLDALIST^PXRMVPTR(801.4118,.01,.ALIST)
+15 ;Plus field 15 files
+16 SET ALIST("MH")=601.71
SET ALIST("TX")=811.2
+17 SET ALIST("WH")=790.404
+18 ;Plus field 17 file
+19 SET ALIST("OI")=101.43
+20 ;
+21 ;Process SOURCE REMINDER
+22 SET SRC=$GET(FDA(801.41,IENS,2))
+23 IF SRC]""
Begin DoDot:1
+24 SET IEN=$$EXISTS^PXRMEXIU(811.9,SRC)
+25 IF IEN=0
KILL FDA(801.41,IENS,2)
End DoDot:1
+26 ;
+27 ;Clear RESULT if not defined
+28 SET RESULT=$GET(FDA(801.41,IENS,55))
+29 IF RESULT]""
Begin DoDot:1
+30 SET IEN=$$EXISTS^PXRMEXIU(801.41,RESULT)
+31 IF IEN=0
KILL FDA(801.41,IENS,55)
End DoDot:1
+32 ;
+33 FOR TYPE="OI","FI","AF","DC","RG"
Begin DoDot:1
+34 NEW FIELD,NUM
+35 IF TYPE="OI"
SET FIELD=17
SET NUM=801.41
+36 IF TYPE="FI"
SET FIELD=15
SET NUM=801.41
+37 IF TYPE="AF"
SET FIELD=.01
SET NUM=801.4118
+38 IF TYPE="DC"
SET FIELD=2
SET NUM=801.412
+39 IF TYPE="RG"
SET FIELD=.01
SET NUM=801.41121
+40 IF TYPE="FI"
DO TAXCONV(.FDA,IENS)
+41 IF NUM=801.4118!(NUM=801.412)!(NUM=801.41121)
Begin DoDot:2
+42 SET TIENS=""
SET ACTION=""
FOR
SET TIENS=$ORDER(FDA(NUM,TIENS))
if TIENS=""!(PXRMDONE=1)
QUIT
Begin DoDot:3
+43 IF (TYPE="AF")
DO FINDINGS(TIENS,NUM,FIELD,TYPE,.NAMECHG,.ACTION,.FDA,.PXRMDONE)
+44 IF FDA(NUM,TIENS,.01)["ST."
SET HASSKT=1
QUIT
+45 IF FDA(NUM,TIENS,.01)["IM."
SET HASIMM=1
+46 IF TYPE'="AF"
DO COMPS(TIENS,NUM,FIELD,TYPE,.NAMECHG,.ACTION,.FDA,.PXRMDONE)
End DoDot:3
End DoDot:2
+47 IF NUM=801.41
Begin DoDot:2
+48 DO FINDINGS(IENS,NUM,FIELD,TYPE,.NAMECHG,.ACTION,.FDA,.PXRMDONE)
+49 IF $GET(FDA(NUM,IENS,15))["ST."
SET HASSKT=1
+50 IF $GET(FDA(NUM,IENS,15))["IM."
SET HASIMM=1
End DoDot:2
End DoDot:1
if +$GET(PXRMDONE)=1
QUIT
+51 ;
+52 ;Look for replacements of TIU templates.
+53 IF $DATA(NAMECHG(8927.1))
Begin DoDot:1
+54 SET WP=$GET(FDA(801.41,IENS,25))
+55 IF WP'=""
DO TIURPL("{FLD:",WP,.NAMECHG,8927.1)
+56 SET WP=$GET(FDA(801.41,IENS,35))
End DoDot:1
+57 ;
+58 DO BLCONV(.FDA)
+59 IF $DATA(FDA(801.41143))
DO BLDCONV1(.FDA)
+60 DO VIMMCONV(.FDA,IENS,HASSKT,HASIMM)
+61 QUIT
+62 ;
+63 ;===============================================
+64 ;Convert ICD9 codes to `ien format
ICD9(CODE) ;
+1 NEW IEN
+2 SET IEN=$$FIND1^DIC(80,"","AMX",$PIECE(CODE,".",2,99))
+3 IF 'IEN
QUIT ""
+4 QUIT IEN
+5 ;
+6 ;
COMPS(IENS,NUM,FIELD,TYPE,NAMECHG,ACTION,FDA,PXRMDONE) ;
+1 NEW FILENUM,IEN,NAMECHG,NEWNAME,PT01,TEXT
+2 FOR
SET IENS=$ORDER(FDA(NUM,IENS))
if IENS=""
QUIT
Begin DoDot:1
+3 SET PT01=$GET(FDA(NUM,IENS,FIELD))
if PT01=""
QUIT
+4 SET FILENUM=801.41
SET NEWNAM=$GET(NAMECHG(FILENUM,PT01))
+5 IF NEWNAM'=""
Begin DoDot:2
+6 SET FDA(NUM,IENS,2)=NEWNAM
SET PT01=NEWNAM
End DoDot:2
+7 SET IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
+8 IF IEN=0
Begin DoDot:2
+9 ;Get replacement
+10 NEW DIC,DIR,DUOUT,MSG,X,Y
+11 SET MSG(1)=" "
+12 SET MSG(2)=$SELECT(TYPE="RG":"RESULT GROUP",1:"COMPONENT DIALOG")_" entry "_PT01_" does not exist."
+13 DO MES^XPDUTL(.MSG)
+14 SET ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
+15 IF ACTION="S"
SET ACTION="Q"
+16 IF ACTION="Q"
QUIT
+17 IF ACTION="D"
KILL FDA(NUM,IENS)
QUIT
+18 SET DIC=FILENUM
+19 SET DIC(0)="AEMNQ"
+20 SET DIC("S")="I ""S""[$P(^PXRMD(801.41,Y,0),U,4)"
+21 SET Y=-1
+22 FOR
if +Y'=-1
QUIT
Begin DoDot:3
+23 ;If this is being called during a KIDS install we need echoing on.
+24 IF $DATA(XPDNM)
XECUTE ^%ZOSF("EON")
+25 DO ^DIC
+26 IF $DATA(XPDNM)
XECUTE ^%ZOSF("EOFF")
+27 IF $DATA(DUOUT)
SET Y=""
QUIT
+28 IF Y=-1
DO BMES^XPDUTL("You must input a replacement!")
End DoDot:3
+29 IF Y=""
SET ACTION="Q"
QUIT
+30 IF Y'=""
SET FDA(NUM,IENS,.01)=$PIECE(Y,U,2)
End DoDot:2
End DoDot:1
IF ACTION="Q"
KILL FDA
SET PXRMDONE=1
QUIT
+31 QUIT
+32 ;
FINDINGS(IENS,NUM,FIELD,TYPE,NAMECHG,ACTION,FDA,PXRMDONE) ;
+1 NEW ABBR,FILENUM,ITEM,IEN,NAMECHG,ORIG,SET,TEXT
+2 SET (ITEM,ORIG)=$GET(FDA(NUM,IENS,FIELD))
SET ACTION=""
+3 IF ITEM'=""
Begin DoDot:1
+4 SET TEXT=""
+5 SET ABBR=$SELECT(TYPE="OI":"OI",1:$PIECE(ITEM,".",1))
+6 SET PT01=$SELECT(TYPE="OI":ITEM,1:$PIECE(ITEM,".",2))
+7 SET FILENUM=$PIECE(ALIST(ABBR),U)
+8 IF $DATA(NAMECHG(FILENUM,PT01))
Begin DoDot:2
+9 SET ITEM=$SELECT(TYPE="OI":NAMECHG(FILENUM,PT01),1:ABBR_"."_NAMECHG(FILENUM,PT01))
+10 SET FDA(NUM,IENS,FIELD)=ITEM
End DoDot:2
+11 SET IEN=$SELECT(TYPE="OI":+$$VFIND1^PXRMEXIU(ABBR_"."_ITEM,.ALIST),1:+$$VFIND1^PXRMEXIU(ITEM,.ALIST))
+12 IF IEN>0
SET TEMP=$$VDLGFIND^PXRMEXIU(ABBR,IEN,.ALIST)
IF TEMP<1
Begin DoDot:2
+13 SET IEN=0
+14 SET TEXT=$SELECT(TYPE="OI":"ORDERABLE ITEM",TYPE="AF":"ADDITIONAL FINDING",1:"FINDING")_" entry "_ITEM_" "_$SELECT(TEMP=0:"is inactive.",1:" does not have codes marked to be used in a dialog.")
End DoDot:2
+15 IF IEN>0
SET FDA(NUM,IENS,FIELD)=$SELECT(TYPE="OI":"`"_IEN,1:ABBR_".`"_IEN)
+16 IF IEN=0
Begin DoDot:2
+17 SET SET=0
+18 ;I $D(^TMP($J,"PXRM FINDING REPLACE",NUM,FIELD,ORIG)) D
+19 ;.S ITEM=$G(^TMP($J,"PXRM FINDING REPLACE",NUM,FIELD,ORIG)) I ITEM="" Q
+20 IF $DATA(^TMP($JOB,"PXRM FINDING REPLACE",ORIG))
Begin DoDot:3
+21 SET ITEM=$GET(^TMP($JOB,"PXRM FINDING REPLACE",ORIG))
IF ITEM=""
QUIT
+22 SET FDA(NUM,IENS,FIELD)=ITEM
SET SET=1
End DoDot:3
+23 IF SET=1
QUIT
+24 IF TEXT=""
SET TEXT=$SELECT(TYPE="OI":"ORDERABLE ITEM",TYPE="AF":"ADDITIONAL FINDING",1:"FINDING")_" entry "_ITEM_" does not exist."
+25 ;Get replacement
+26 NEW DIC,DIR,DUOUT,MSG,X,Y
+27 SET MSG(1)=" "
+28 SET MSG(2)=TEXT
+29 DO MES^XPDUTL(.MSG)
+30 SET ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
IF ACTION="S"
SET ACTION="Q"
+31 IF ACTION="Q"
QUIT
+32 IF ACTION="D"
KILL FDA(NUM,IENS,FIELD)
QUIT
+33 SET DIC=FILENUM
+34 SET DIC(0)="AEMNQ"
+35 SET DIC("S")="I $$FILESCR^PXRMDLG6(Y,FILENUM)=1"
+36 SET Y=-1
+37 FOR
if +Y'=-1
QUIT
Begin DoDot:3
+38 ;If this is being called during a KIDS install we need echoing on.
+39 IF $DATA(XPDNM)
XECUTE ^%ZOSF("EON")
+40 DO ^DIC
+41 IF $DATA(XPDNM)
XECUTE ^%ZOSF("EOFF")
+42 ;If this is being called during a KIDS install we need echoing on.
+43 IF $DATA(DUOUT)
SET Y=""
QUIT
+44 IF Y=-1
DO BMES^XPDUTL("You must input a replacement!")
End DoDot:3
+45 IF Y=""
SET ACTION="Q"
QUIT
+46 SET ITEM=$SELECT(TYPE="OI":$PIECE(Y,U,2),1:ABBR_"."_$PIECE(Y,U,2))
+47 SET FDA(NUM,IENS,FIELD)=ITEM
End DoDot:2
+48 ;Save the finding information for the history.
+49 IF ITEM'=ORIG
Begin DoDot:2
+50 SET ^TMP("PXRMEXIA",$JOB,"DIAF",$PIECE(IENS,",",1),ORIG)=ITEM
+51 SET ^TMP($JOB,"PXRM FINDING REPLACE",ORIG)=ITEM
End DoDot:2
End DoDot:1
IF ACTION="Q"
KILL FDA
SET PXRMDONE=1
QUIT
+52 QUIT
+53 ;
SETWARN(TEXT) ;
+1 SET TEXT(1)="PREVIOUSLY THE DIALOG WAS SET TO BOTH CURRENT AND HISTORICAL ENCOUNTERS."
+2 SET TEXT(2)="DIALOG IS NOW SET TO CURRENT ENCOUNTER ONLY."
+3 SET TEXT(3)="REVIEW THE DIALOG BEFORE USING IN CPRS."
+4 QUIT
+5 ;
TAXARRAY(FINDING,CNT,ARRAY) ;
+1 ; add to code list to create a new taxonomy
+2 NEW CODE,CODESYS,CODESYSN,IEN
+3 SET CODESYS=$PIECE(FINDING,".")
SET CODE=$PIECE(FINDING,".",2,99)
+4 IF $PIECE(CODESYS,".")'["ICD9"
IF $PIECE(CODESYS,".")'["CPT"
QUIT
+5 SET CODESYSN=$SELECT(CODESYS[9:"ICD",1:"CPT")
+6 SET IEN=$$EXISTS^PXRMEXIU($SELECT(CODESYSN="ICD":80,1:81),CODE)
+7 SET CNT=CNT+1
SET ARRAY("CODE",CODESYSN,IEN)="I"_U_1
+8 QUIT
+9 ;
TAXCONV(FDA,IENS) ;
+1 ; FINDING ITEM FDA(801.41,IENS,15)
+2 ; ADDITIONAL FINDINGS FDA(801.4118,IENS)
+3 NEW ADDIENS,ARRAY,CNT,ERROR,FINDING,FINDS,ISFNDFLD,LAST,NAME,OCNT,TAX,TAXNAME,TEMP,TFINDS
+4 SET ISFNDFLD=0
SET CNT=0
+5 ;if finding is taxonomy add the correct fields to the element
+6 SET FINDING=$GET(FDA(801.41,IENS,15))
+7 IF $PIECE(FINDING,".")="TX"
DO TAXCONV1(.FDA,IENS,FINDING)
QUIT
+8 ;
+9 IF FINDING'=""
Begin DoDot:1
+10 DO TAXARRAY(FINDING,.CNT,.ARRAY)
+11 ;if array defined then finding has a code kill the node off.
+12 IF $DATA(ARRAY)
SET ISFNDFLD=1
KILL FDA(801.41,IENS,15)
End DoDot:1
+13 ;loop through additional findings
+14 SET FINDS=""
FOR
SET FINDS=$ORDER(FDA(801.4118,FINDS))
if FINDS=""
QUIT
Begin DoDot:1
+15 SET FINDING=FDA(801.4118,FINDS,.01)
+16 SET OCNT=CNT
DO TAXARRAY(FINDING,.CNT,.ARRAY)
IF CNT>OCNT
SET TFINDS(FINDS)=""
End DoDot:1
+17 ;kill off additional findings that are codes
+18 SET ADDIENS=""
+19 SET FINDS=""
FOR
SET FINDS=$ORDER(TFINDS(FINDS))
if FINDS=""
QUIT
Begin DoDot:1
+20 KILL FDA(801.4118,FINDS)
+21 IF ADDIENS=""
SET ADDIENS=FINDS
End DoDot:1
+22 IF '$DATA(ARRAY)
QUIT
+23 ;build values to crate a new taxonomy
+24 SET NAME=$GET(FDA(801.41,IENS,.01))
+25 SET TEMP=$$RTAXNAME^PXRMDUTL(NAME)
+26 SET ARRAY("NAME")=TEMP
+27 SET ARRAY("COUNT")=CNT
+28 SET ARRAY("CLASS")=$GET(FDA(801.41,IENS,100))
+29 SET ARRAY("SOURCE")="Exchange installed of dialog "_NAME
+30 ;create new taxonomy API
+31 SET TAX=$$CRETAX^PXRMTXIM("E",.ARRAY,.ERROR)
+32 IF $DATA(ERROR)
Begin DoDot:1
+33 IF $GET(TAX)=0
DO BMES^XPDUTL("ERROR: Taxonomy could not be created for dialog "_NAME_".")
HANG 1
QUIT
+34 DO BMES^XPDUTL("ERROR: failed to add all the codes to the Taxonomy "_TEMP_". The codes that could not be added are:")
+35 DO BMES^XPDUTL(.ERROR)
+36 HANG 1
End DoDot:1
QUIT
+37 SET TAXNAME=$PIECE($GET(^PXD(811.2,TAX,0)),U)
+38 DO BMES^XPDUTL("Taxonomy "_TAXNAME_" created")
HANG 1
+39 IF ISFNDFLD=1
Begin DoDot:1
+40 SET FDA(801.41,IENS,15)="TX.`"_TAX
+41 SET FDA(801.41,IENS,123)="NO PICK LIST"
End DoDot:1
QUIT
+42 SET FINDS=$ORDER(FDA(801.4118,""),-1)
+43 SET LAST=$ORDER(FDA(801.44,""),-1)
IF LAST=""
QUIT
+44 SET TEMP=$PIECE($PIECE(LAST,"+",2),",")+1
SET TEMP="+"_TEMP
+45 SET FDA(801.4118,ADDIENS,.01)="TX.`"_TAX
+46 QUIT
+47 ;
TAXCONV1(FDA,IENS,FINDING) ;
+1 NEW CNT,CPTSTATUS,DEFAULT,DNUM,ENC,ENCTYPE,IEN,NODE,NODECNT
+2 NEW PROMPTS,POVSTATUS,START,TAX,TEXT,TAXIEN,TDX,TPR,TYPE,VALUE,X
+3 ;if taxonomy fields defined then quit
+4 IF ($GET(FDA(801.41,IENS,123))'="")
QUIT
+5 ;if group set to not display a pick list.
+6 IF FDA(801.41,IENS,4)["group"
SET FDA(801.41,IENS,123)="N"
QUIT
+7 SET TAX=$PIECE(FINDING,".",2)
+8 SET FDA(801.41,IENS,123)="ALL"
+9 ;
+10 SET TAXIEN=$ORDER(^PXD(811.2,"B",TAX,""))
IF TAXIEN'>0
QUIT
+11 ;determine Taxonomy Type
+12 SET TDX=$$TOK^PXRMDTAX(TAXIEN,"POV")
+13 SET TPR=$$TOK^PXRMDTAX(TAXIEN,"CPT")
+14 DO SETWARN(.TEXT)
+15 ;build default array for taxonomy
+16 SET CPTSTATUS=$$GETSTAT^PXRMDTAX("CPT")
SET POVSTATUS=$$GETSTAT^PXRMDTAX("POV")
+17 IF TDX=1
DO GETTAXDF^PXRMDTAX(.DEFAULT,"POV",$SELECT(POVSTATUS=2:1,1:0))
+18 IF TPR=1
DO GETTAXDF^PXRMDTAX(.DEFAULT,"CPT",$SELECT(CPTSTATUS=2:1,1:0))
+19 IF TDX
IF TPR
Begin DoDot:1
+20 IF CPTSTATUS=POVSTATUS
IF POVSTATUS=2
SET FDA(801.41,IENS,13)="2"
QUIT
+21 SET FDA(801.41,IENS,13)="@"
+22 IF CPTSTATUS=0!(POVSTATUS=0)
DO BMES^XPDUTL(.TEXT)
End DoDot:1
+23 IF TDX
IF TPR=0
Begin DoDot:1
+24 IF POVSTATUS=2
SET FDA(801.41,IENS,13)="2"
QUIT
+25 SET FDA(801.41,IENS,13)="@"
IF POVSTATUS=0
DO BMES^XPDUTL(.TEXT)
End DoDot:1
+26 IF TDX=0
IF TPR=1
Begin DoDot:1
+27 IF CPTSTATUS=2
SET FDA(801.41,IENS,13)="2"
QUIT
+28 SET FDA(801.41,IENS,13)="@"
IF CPTSTATUS=0
DO BMES^XPDUTL(.TEXT)
End DoDot:1
+29 SET NODECNT=$ORDER(FDA(801.44,""),-1)
IF NODECNT=""
QUIT
+30 ;
+31 ;build encounter tax field
+32 FOR TYPE="POV","CPT"
Begin DoDot:1
+33 IF TYPE="POV"
IF TDX=0
QUIT
+34 IF TYPE="CPT"
IF TPR=0
QUIT
+35 IF TYPE="POV"
SET X=141
+36 IF TYPE="CPT"
SET X=142
+37 SET VALUE=$$ADDTAXF1^PXRMDTAX(TYPE,.DEFAULT)
+38 SET FDA(801.41,IENS,X)=VALUE
+39 ;
+40 ;build prompt array from default list
+41 SET TYPE=""
FOR
SET TYPE=$ORDER(DEFAULT(TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+42 ;I TPR=0,CODE="CPT" Q
+43 ;I TDX=0,CODE="POV" Q
+44 SET CNT=0
FOR
SET CNT=$ORDER(DEFAULT(TYPE,"ADDFIND",CNT))
if CNT'>0
QUIT
Begin DoDot:3
+45 SET NODE=DEFAULT(TYPE,"ADDFIND",CNT)
SET IEN=$PIECE(NODE,U)
+46 IF $DATA(PROMPTS(IEN))>0
IF $LENGTH(PROMPTS(IEN),U)<$LENGTH(NODE,U)
SET PROMPTS(IEN)=NODE
+47 SET PROMPTS(IEN)=NODE
End DoDot:3
End DoDot:2
End DoDot:1
+48 ;
+49 IF $GET(FDA(801.41,IENS,122))="YES"
KILL FDA(801.41,IENS,122)
QUIT
+50 IF $DATA(FDA(801.412))
QUIT
+51 ;
+52 ;add prompts to the dialog element.
+53 SET START=0
SET IEN=0
SET CNT=0
SET DNUM=0
+54 SET IEN=0
SET CNT=0
FOR
SET IEN=$ORDER(PROMPTS(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+55 SET START=START+1
SET DNUM=DNUM+1
+56 SET NAME=$PIECE($GET(^PXRMD(801.41,IEN,0)),U)
+57 SET NODE=PROMPTS(IEN)
SET CNT=$LENGTH(NODE,U)
+58 IF $PIECE(NODE,U,3)>0
QUIT
+59 SET NODECNT=NODECNT+1
+60 SET FDA(801.412,"+"_NODECNT_","_IENS,.01)=START
+61 SET FDA(801.412,"+"_NODECNT_","_IENS,2)="`"_IEN
+62 IF CNT=1
QUIT
+63 FOR NUM=2:1:CNT
Begin DoDot:2
+64 SET VALUE=$PIECE(NODE,U,NUM)
IF $GET(VALUE)=""
QUIT
+65 SET FIELD=$SELECT(NUM=2:9,NUM=4:.01,NUM=5:6,NUM=6:7,NUM=7:8,1:"")
IF $GET(FIELD)=""
QUIT
+66 IF FIELD>6
SET VALUE=$SELECT(VALUE=1:"YES",1:"NO")
+67 SET FDA(801.412,"+"_NODECNT_","_IENS,FIELD)=VALUE
End DoDot:2
End DoDot:1
+68 QUIT
+69 ;
+70 ;===============================================
TIURPL(SRCH,WP,NAMEGHC,FILENUM) ;Replace TIU templates whose names have
+1 ;changed.
+2 NEW IND,RS,TEXT,TS,TYPE
+3 IF FILENUM=8927.1
SET TYPE="TIU TEMPLATE"
+4 IF '$TEST
SET TYPE="TIU OBJECT"
+5 SET IND=1
+6 FOR
SET TEXT=$GET(@WP@(IND))
if TEXT=""
QUIT
Begin DoDot:1
+7 IF TEXT[SRCH
Begin DoDot:2
+8 SET TS=""
+9 FOR
SET TS=$ORDER(NAMECHG(FILENUM,TS))
if TS=""
QUIT
Begin DoDot:3
+10 SET RS=NAMECHG(FILENUM,TS)
if TEXT'[TS
QUIT
+11 SET @WP@(IND)=$$STRREP^PXRMUTIL(TEXT,TS,RS)
+12 ;Save the replacement information for the history.
+13 SET ^TMP("PXRMEXIA",$JOB,"DIATIU",TYPE,TS)=RS
+14 SET ^TMP("PXRMEXIA",$JOB,"DIATIU",TYPE,TS,DNAM)=""
End DoDot:3
End DoDot:2
+15 SET IND=IND+1
End DoDot:1
+16 QUIT
+17 ;
