PXRMP26D ;SLC/AGP - Dialog Conversion for PXRM*2.0*26. ;05/07/2014
;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
Q
;
;this code is used to add prompts to a dialog from file 801.45. This
;should only be called when an existing dialog contains a taxonomy
;and prompts are not set in the dialog.
PROMPTS(DIEN,SEL,DEFAULT,IENCNT,FDA) ;
N CNT,CODE,DIR,DNUM,ENC,FIELD,IEN,IENS,NAME,NODE,NUM,PROMPT,PROMPTS,START,VALUE,Y
;
;if prompts already defined then Quit keeps existing functionality
;in sync prompts at element level override prompts for taxonomy
D MES^XPDUTL("Adding prompts to the dialog.")
S START=+$O(^PXRMD(801.41,DIEN,10,""),-1) I START>0 Q
;
S CODE="" F S CODE=$O(DEFAULT(CODE)) Q:CODE="" D
.I SEL="P",CODE="POV" Q
.I SEL="D",CODE="CPT" Q
.S CNT=0 F S CNT=$O(DEFAULT(CODE,"ADDFIND",CNT)) Q:CNT'>0 D
..S NODE=DEFAULT(CODE,"ADDFIND",CNT)
..S IEN=$P(NODE,U)
..I $D(^PXRMD(801.41,DIEN,10,"D",IEN))>0 Q
..I $D(PROMPTS(IEN))>0 I $L(PROMPTS(IEN),U)<$L(NODE,U) S PROMPTS(IEN)=NODE
..S PROMPTS(IEN)=NODE
;
I '$D(PROMPTS) Q
S START=+$O(^PXRMD(801.41,DIEN,10,""),-1)
S DNUM=0
S IEN=0,CNT=0 F S IEN=$O(PROMPTS(IEN)) Q:IEN'>0 D
.S CNT=CNT+1,START=START+1,DNUM=DNUM+1
.S IENCNT=IENCNT+1,IENS="+"_IENCNT_","_DIEN_","
.;S IENCNT=IENCNT+1,IENS="+"_IENCNT_",1,"
.S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
.S NODE=PROMPTS(IEN),CNT=$L(NODE,U)
.I $P(NODE,U,3)>0 Q
.S FDA(801.412,IENS,.01)=START
.S FDA(801.412,IENS,2)=IEN
.I CNT=1 Q
.F NUM=2:1:CNT D
..I NUM=3 Q
..I NUM=4 Q
..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
..S FDA(801.412,IENS,FIELD)=VALUE
Q
;
;this is used to add a taxonomy to a finding in a dialog. Set field
;123 to N this should keep the functionality to the same as pre-ICD10
;functionality.
ADDFIND(DIEN,TAX,UPD,DEFAULT,IENCNT,FDA) ;
N TNAME
S TNAME=$P(^PXD(811.2,TAX,0),U)
D MES^XPDUTL("Adding Taxonomy "_TNAME_" as a Finding Item.")
N IENS
S IENS=DIEN_","
S FDA(801.41,IENS,15)=TAX_";PXD(811.2,"
I UPD=2 S FDA(801.41,IENS,123)="N" Q
;S FDA(801.41,IENS,123)="A"
;I UPD=0 D ADDPROMPT(DIEN,TAX,.DEFAULT,.IENCNT,.FDA)
Q
;
ADDFIND1(DIEN,TAX,DEFAULT,IENCNT,FDA) ;
;additional finding addition does not add prompts to the dialog.
;this should keep existing functionality in place
;may need a decision on this
N TNAME
S TNAME=$P(^PXD(811.2,TAX,0),U)
D MES^XPDUTL("Adding Taxonomy "_TNAME_" as an Additional Finding Item.")
N IENS
S IENCNT=IENCNT+1,IENS="+"_IENCNT_","_DIEN_","
;S IENCNT=IENCNT+1,IENS="?+"_IENCNT_",1,"
S FDA(801.4118,IENS,.01)=TAX_";PXD(811.2,"
Q
;
;This is used to pulled the default taxonomy field values from 801.45
; into 801.41 when updating a dialog that contains a taxonomy.
ADDTAXFL(DIEN,TAX,CODE,DEFAULT,IENCNT,FDA) ;
;D MES^XPDUTL("Adding default Taxonomy Field Values for "_CODE_".")
D MES^XPDUTL("Adding default Header Text for "_CODE_".")
N ENCTYPE,IENS,NODEIEN,RESULT,TEMP,VALUE,X
S VALUE=$$ADDTAXF1^PXRMDTAX(CODE,.DEFAULT)
S X=$S(CODE="POV":141,1:142)
S IENS=DIEN_","
S FDA(801.41,IENS,X)=VALUE
Q
;
;use to build an array of codes to create a taxonomy from
BLDARRAY(DIEN,ARRAY,TCNT,TEXT) ;
N CLASS,CNT,CODESYSN,CODESYS,FNUM,IEN,NAME,TEMP
S CNT=0
S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
S TCNT=TCNT+1,TEXT(TCNT)="Dialog "_NAME_" Pre-conversion codes"
F CODESYS="ICD9(","ICPT(" D
.S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,"DIALOG",DIEN,CODESYS,IEN)) Q:IEN'>0 D
..S CODESYSN=$S(CODESYS[9:"ICD",1:"CPT")
..S CNT=CNT+1,ARRAY("CODE",CODESYSN,IEN)="I"_U_1
..S TCNT=TCNT+1,TEXT(TCNT)=" "_$S(CODESYSN="ICD":"Diagnosis Code",1:"Procedure Code")_": "_$$GET1^DIQ($S(CODESYSN="ICD":80,1:81),IEN,.01)
I CNT=0 Q
S TCNT=TCNT+1,TEXT(TCNT)=""
S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
S CLASS=$P($G(^PXRMD(801.41,DIEN,100)),U)
I CLASS="N" S NAME=$P(NAME,"-",2),CLASS="L"
S TEMP=$$RTAXNAME^PXRMDUTL(NAME)
S ARRAY("NAME")=TEMP
S ARRAY("COUNT")=CNT
S ARRAY("CLASS")=CLASS
S ARRAY("SOURCE")="Reminder Dialog IEN: "_DIEN
Q
;
BLDTAXC(TEXT,TCNT,TIEN,DIEN) ;
N ARRAY,CNT,CODESYS,DNAME,TNAME,X
S TNAME=$P(^PXD(811.2,TIEN,0),U)
S DNAME=$P(^PXRMD(801.41,DIEN,0),U)
S TCNT=TCNT+1,TEXT(TCNT)="Taxonomy "_TNAME_" added to dialog."
S TCNT=TCNT+1,TEXT(TCNT)="Taxonomy "_TNAME_" post-conversion codes list:"
F X="POV","CPT" D
.K CODESYS,ARRAY
.D BLDCODE^PXRMDTAX(X,.CODESYS),CODES^PXRMDLLB(TIEN,.CODESYS,.ARRAY)
.S CNT=0 F S CNT=$O(ARRAY(CNT)) Q:CNT'>0 S TCNT=TCNT+1,TEXT(TCNT)=" "_$S(X="POV":"Diagnosis Code",1:"Procedure Code")_": "_$P($P(ARRAY(CNT),U,2),":")
Q
;create new taxonomy from dialog findings/additional findings,
;trap errors, and store new taxonomy and codes
CREATE(ARRAY,DIEN,TCNT,TEXT) ;
N CNT,IEN,CODESYS,CODE,ERR
S IEN=$$CRETAX^PXRMTXIM("",.ARRAY,.ERR)
I $D(ERR) D
.I IEN=0 D Q
..S TCNT=TCNT+1,TEXT(TCNT)="ERROR: A taxonomy could not be created"
..S ^XTMP(PXRMXTMP,"DIALOG ERROR",DIEN,"ERROR")="Could not create a taxonomy. Dialog had the following codes assigned:"
..;S ^XTMP(PXRMXTMP,"DIALOG ERROR",DIEN,"ERROR","DIALOG IEN")=DIEN
..M ^XTMP(PXRMXTMP,"DIALOG ERROR",DIEN,"ERROR","CODE")=ARRAY("CODE")
.I IEN>0 D
..S TCNT=TCNT+1,TEXT(TCNT)="ERROR: failed to add all the codes to the Taxonomy "_ARRAY("NAME")
..S ^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN,"ERROR")="Could not add the following codes to the Taxonomy "_ARRAY("NAME")
..M ^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN,"ERROR","CODE")=ERR
..;S ^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN,"ERROR","TAXIEN")=IEN
I IEN=0 Q 0
S ^XTMP(PXRMXTMP,"TAXONOMY",IEN)=""
S ^XTMP(PXRMXTMP,"TAXONOMY",IEN,"NAME")=ARRAY("NAME") K ARRAY("NAME")
S ^XTMP(PXRMXTMP,"TAXONOMY",IEN,"COUNT")=ARRAY("COUNT") K ARRAY("COUNT")
M ^XTMP(PXRMXTMP,"TAXONOMY",IEN,"DATA")=ARRAY("CODE")
D BLDTAXC(.TEXT,.TCNT,IEN,DIEN)
Q IEN
;
;determine if a new taxonomy needs to be use or if new taxonomy
;already exist
CRETAX ;
N ARRAY,CNT,DIEN,FIND,HASCODE,IEN,NAME,TAX,TCNT,TEXT,TYPE
D MES^XPDUTL(" ")
D MES^XPDUTL("Dialogs updates")
S DIEN=0 F S DIEN=$O(^XTMP(PXRMXTMP,"DIALOG",DIEN)) Q:DIEN'>0 D
.I $G(^XTMP(PXRMXTMP,"DIALOG",DIEN,"DONE"))=1 Q
.K ARRAY,TEXT
.S TCNT=0
.D BLDARRAY(DIEN,.ARRAY,.TCNT,.TEXT) I '$D(ARRAY) Q
.S TAX=$$TAXEXIST(.ARRAY,DIEN,.TCNT,.TEXT) I TAX>0 S ^XTMP(PXRMXTMP,"DIALOG",DIEN,"PXD(811.2,",TAX)=2
.I TAX<1 S TAX=$$CREATE(.ARRAY,DIEN,.TCNT,.TEXT) I TAX>0 S ^XTMP(PXRMXTMP,"DIALOG",DIEN,"PXD(811.2,",TAX)=2
.S TCNT=TCNT+1,TEXT(TCNT)=""
.D MES^XPDUTL(.TEXT)
Q
;
;DEBUG CODE del to make clean-up easier for errors while in development
DELXTMP ;
N ARRAY,DIEN,FIND,PXRMXTMP,TEMP,TIEN
S PXRMXTMP="PXRM DIALOG CONVERSION",TEMP="DIALOG",FIND="PXD(811.2,"
S DIEN=0 F S DIEN=$O(^XTMP(PXRMXTMP,TEMP,DIEN)) Q:DIEN'>0 D
.S TIEN=0 F S TIEN=$O(^XTMP(PXRMXTMP,TEMP,DIEN,FIND,TIEN)) Q:TIEN'>0 D
..I +$G(^XTMP(PXRMXTMP,TEMP,DIEN,FIND,TIEN))=2 S ARRAY(DIEN,TIEN)=""
S DIEN=0 F S DIEN=$O(ARRAY(DIEN)) Q:DIEN'>0 D
.S TIEN=0 F S TIEN=$O(ARRAY(DIEN,TIEN)) Q:TIEN'>0 D
..K ^XTMP(PXRMXTMP,TEMP,DIEN,FIND,TIEN)
Q
;
;build edit history from FDA array.
EDITDES(DIEN,FDA,WP) ;
N CNT
S CNT=1
D MES^XPDUTL("Updating edit history of the dialog.")
i $g(FDA(801.41,DIEN_",",13))'="" S CNT=CNT+1,WP(CNT,0)=" Set Resolution Type to Done Elsewhere (Historical)"
I $G(FDA(801.41,DIEN_",",15))'="" S CNT=CNT+1,WP(CNT,0)=" Updated Finding Item Field"
I $G(FDA(801.41,DIEN_",",123))'="" S CNT=CNT+1,WP(CNT,0)=" Updated Taxonomy Selection Field to "_$G(FDA(801.41,DIEN_",",123))
I $G(FDA(801.41,DIEN_",",141))'="" S CNT=CNT+1,WP(CNT,0)=" Updated Diagnosis Header Text"
I $G(FDA(801.41,DIEN_",",142))'="" S CNT=CNT+1,WP(CNT,0)=" Updated Diagnosis Header Text"
;I $D(FDA(801.46)) S CNT=CNT+1,WP(CNT,0)=" Update Taxonomy Fields"
I $D(FDA(801.4118)) S CNT=CNT+1,WP(CNT,0)=" Update Additional Finding Item Multiple"
I $D(FDA(801.412)) S CNT=CNT+1,WP(CNT,0)=" Added prompts to the dialog"
I CNT=1 S CNT=CNT+1,WP(CNT,0)=" Nothing"
Q
;
;loops through the xtmp of taxonomy determine the update path
GETLIST ;
N ADDFVPL,CPTSTATUS,DIEN,FINDFVPL,IEN,POVSTATUS,TAXNEEDS,UPDTYPE,VALUE
K ^TMP("PXRMXMZ",$J)
D BLDRLIST^PXRMVPTR(801.41,15,.FINDFVPL)
D BLDRLIST^PXRMVPTR(801.4118,.01,.ADDFVPL)
S CPTSTATUS=$$GETSTAT^PXRMDTAX("CPT"),POVSTATUS=$$GETSTAT^PXRMDTAX("POV")
K ^TMP("PXRMXMZ",$J)
S ^TMP("PXRMXMZ",$J,1,0)="Dialog post-conversion report:"
S DIEN=0 F S DIEN=$O(^XTMP(PXRMXTMP,"DIALOG",DIEN)) Q:DIEN'>0 D
.S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,"DIALOG",DIEN,"PXD(811.2,",IEN)) Q:IEN'>0 D
..S UPDTYPE=^XTMP(PXRMXTMP,"DIALOG",DIEN,"PXD(811.2,",IEN)
..S TAXNEEDS=0
..I $G(^XTMP(PXRMXTMP,"DIALOG",DIEN,"DONE"))'=1 D UPDATE(DIEN,IEN,UPDTYPE,CPTSTATUS,POVSTATUS,.TAXNEEDS)
..D BLDTXT^PXRMP26X(DIEN,.FINDFVPL,.ADDFVPL,TAXNEEDS,0)
I $O(^TMP("PXRMXMZ",$J,""),-1)>1 D SEND^PXRMMSG("PXRMXMZ","Clinical Reminder Patch 26 Post-conversion dialog.")
;K ^TMP("PXRMXMZ",$J)
Q
;
PRE ;
;I $$PATCH^XPDUTL("PXRM*2.0*26") Q
N PXRMXTMP,PXRMSKIP
S PXRMXTMP="PXRM DIALOG CONVERSION"
K ^XTMP(PXRMXTMP)
S ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"PXRM Patch 26 Dialog Conversion"
S PXRMSKIP("VA-WH PAP SMEAR OBTAINED")="",PXRMSKIP("VA-GP AAA PRIOR DIAGNOSIS")=""
S PXRMSKIP("VA-IM FLU H1N1 DONE (1 DOSE)")="",PXRMSKIP("VA-IM FLU H1N1 OUTSIDE (1 DOSE)")=""
S PXRMSKIP("VA-IM FLU HIGH DOSE DONE")="",PXRMSKIP("VA-IM FLU HIGH DOSE OUTSIDE")=""
D BLDLIST^PXRMP26X(.PXRMSKIP)
Q
;
POST ;
;I $$PATCH^XPDUTL("PXRM*2.0*26") Q
K ^TMP($J,"PXRM TAX"),^TMP("PXRM DIALOG UPD",$J),^TMP("PXRM DIALOG STR",$J)
N PXRMXTMP
S PXRMXTMP="PXRM DIALOG CONVERSION"
D CRETAX
D GETLIST
D WRITE
D MAKNAT(801.41,"ADD TO PROBLEM LIST","PXRM FV ADD TO PROBLEM LIST")
D RENAME^PXRMUTIL(801.41,"VA-ECOE DX LIST","VA-ECOE DX GROUP")
;K ^XTMP(PXRMXTMP),^TMP($J,"PXRM TAX"),^TMP("PXRM DIALOG UPD",$J),^TMP("PXRM DIALOG STR",$J)
K ^TMP($J,"PXRM TAX"),^TMP("PXRM DIALOG UPD",$J),^TMP("PXRM DIALOG STR",$J)
Q
;
MAKNAT(FILENUM,OLDNAME,NEWNAME) ;Rename entry OLDNAME to NEWNAME in
;file number FILENUM.
N DA,DIE,DR,NIEN,PXRMINST,TEXT
S DA=$$FIND1^DIC(FILENUM,"","BXU",OLDNAME)
I DA=0 Q
S PXRMINST=1
S NIEN=$$FIND1^DIC(FILENUM,"","BXU",NEWNAME) I NIEN>0 Q
S DIE=FILENUM
S DR=".01///^S X=NEWNAME;100///N"
D ^DIE
S TEXT(1)="Converting "_OLDNAME_" IEN: "_DA,TEXT(2)="to national value "_NEWNAME
D MES^XPDUTL(.TEXT)
Q
;
;compare array with new taxonomies already created if one matches the
;array returns that taxonomy IEN
TAXEXIST(ARRAY,DIEN,TCNT,TEXT) ;
N CIEN,CODESYS,FAIL,IEN,MATCH,RESULT,EDATE,SDATE,TAX,TYPE
S RESULT=0,MATCH=0
S TAX=0 F S TAX=$O(^XTMP(PXRMXTMP,"TAXONOMY",TAX)) Q:TAX'>0!(MATCH=1) D
.I ^XTMP(PXRMXTMP,"TAXONOMY",TAX,"COUNT")'=ARRAY("COUNT") Q
.S FAIL=0
.S TYPE="" F S TYPE=$O(^XTMP(PXRMXTMP,"TAXONOMY",TAX,"DATA",TYPE)) Q:TYPE=""!(FAIL=1) D
..S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,"TAXONOMY",TAX,"DATA",TYPE,IEN)) Q:IEN'>0!(FAIL=1) D
...I '$D(ARRAY("CODE",TYPE,IEN)) S FAIL=1 Q
.I FAIL=0 S RESULT=TAX,MATCH=1 D BLDTAXC(.TEXT,.TCNT,RESULT,DIEN)
Q RESULT
;
;determine what updates are needed for the Taxonomy
; add taxonomy as a finding item/additional finding item if prompts
;should be added
; calls UPDATE^DIE
UPDATE(DIEN,TAX,UPDTYPE,CPTSTATUS,POVSTATUS,TAXNEEDS) ;
N CLASS,DEFAULT,DNAME,FDA,FIND,IENCNT,IENROOT,IENS,MSG,NAME,SAME,START,TEXT,TDX,TPR,TYPE,TAXSEL
S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
D MES^XPDUTL("Updating record for dialog "_DNAME_" IEN: "_DIEN)
S IENROOT(1)=DIEN
S TDX=$$TOK^PXRMDTAX(TAX,"POV")
S TPR=$$TOK^PXRMDTAX(TAX,"CPT")
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=0,TPR=0 D Q
.S ^XTMP(PXRMXTMP,"DIALOG ERROR",DIEN,"ERROR")="A taxonomy does not have codes marked to be used in a dialog."
S IENCNT=DIEN
;
S FIND=$P($G(^PXRMD(801.41,DIEN,1)),U,5) I FIND'="" D G UPDATEX
.S SAME=0 I FIND[811.2 D
..;if same find only add prompts if suppress prompts is null
..I +FIND=TAX D Q
...S SAME=1
...I UPDTYPE<2 D
....S TAXSEL="N"
....I TPR=1 S TAXSEL="P" I POVSTATUS=2 S FDA(801.41,DIEN_",",13)="2"
....I TDX=1 S TAXSEL="D" I CPTSTATUS=2 S FDA(801.41,DIEN_",",13)="2"
....I TPR=1,TDX=1 D
.....K FDA(801.41,DIEN_",",13)
.....S TAXSEL="A"
.....I CPTSTATUS=POVSTATUS,POVSTATUS=2 S FDA(801.41,DIEN_",",13)="2" Q
.....I CPTSTATUS'=POVSTATUS S TAXNEEDS=1
....S FDA(801.41,DIEN_",",123)=TAXSEL
....I TDX=1 D ADDTAXFL(DIEN,TAX,"POV",.DEFAULT,.IENCNT,.FDA)
....I TPR=1 D ADDTAXFL(DIEN,TAX,"CPT",.DEFAULT,.IENCNT,.FDA)
...I UPDTYPE=1 D PROMPTS(DIEN,TAXSEL,.DEFAULT,.IENCNT,.FDA)
. I SAME=1 Q
. D ADDFIND1(DIEN,TAX,.DEFAULT,.IENCNT,.FDA)
;
D ADDFIND(DIEN,TAX,UPDTYPE,.DEFAULT,.IENCNT,.FDA)
;
UPDATEX ;
;populate edit history
N WP
S WP(1,0)="Reminder Code Conversion Routine did the following:"
D EDITDES(DIEN,.FDA,.WP)
;S IENCNT=IENCNT+1,IENS="+"_IENCNT_","_DIEN_","
S IENCNT=IENCNT+1,IENS="+"_IENCNT_","_DIEN_","
S FDA(801.44,IENS,.01)=DT
S FDA(801.44,IENS,1)=DUZ
S FDA(801.44,IENS,2)="WP"
;populate required fields from existing entry
S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
S CLASS=$P($G(^PXRMD(801.41,DIEN,100)),U)
S TYPE=$P($G(^PXRMD(801.41,DIEN,0)),U,4)
;
S FDA(801.41,DIEN_",",.01)=NAME
S FDA(801.41,DIEN_",",4)=TYPE
S FDA(801.41,DIEN_",",100)=CLASS
D UPDATE^DIE("","FDA","","MSG")
I '$D(MSG) S ^XTMP(PXRMXTMP,"DIALOG",DIEN,"DONE")=1
I $D(MSG) D AWRITE^PXRMUTIL("MSG")
S ^XTMP(PXRMXTMP,"DIALOG UPDATED",DIEN)=1
D MES^XPDUTL("Completed record updates for dialog "_DNAME_" IEN: "_DIEN)
D MES^XPDUTL(" ")
Q
;
;DEBUG CODE to be deleted
WRITENAM ;
N NAME,PXRMXTMP,TEMP,DIEN
S PXRMXTMP="PXRM DIALOG CONVERSION",TEMP="DIALOG"
S DIEN=0 F S DIEN=$O(^XTMP(PXRMXTMP,TEMP,DIEN)) Q:DIEN'>0 D
.S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
.I NAME["WAT" D
..K ^XTMP(PXRMXTMP,TEMP,DIEN,"ICD9(")
Q
;
;write out the final overview when the updates are done
WRITE ;
N ARRAY,CNT,FIRST,IEN,NAME,NODE,TEXT,CODESYS,CODE
S CNT=0
D MES^XPDUTL("Overview")
I $D(^XTMP(PXRMXTMP,"TAXONOMY"))>0 D
. S CNT=0
. ;S CNT=CNT+1,TEXT(CNT)="The following Taxonomies were created:"
. S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,"TAXONOMY",IEN)) Q:IEN'>0 S CNT=CNT+1
. I CNT>0 D MES^XPDUTL("Created "_CNT_" taxonomies")
;
I $D(^XTMP(PXRMXTMP,"DIALOG UPDATED"))>0 D
. S CNT=0
. S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,"DIALOG UPDATED",IEN)) Q:IEN'>0 S CNT=CNT+1
. I CNT>0 D MES^XPDUTL("Updated "_CNT_" dialogs")
I '$D(^XTMP(PXRMXTMP,"DIALOG UPDATED")),$D(^XTMP(PXRMXTMP,"TAXONOMY ERROR")) D MES^XPDUTL("No errors found") Q
S CNT=1
;
S TEXT(CNT,0)="Manual Correction is needed for the following items"
I $D(^XTMP(PXRMXTMP,"DIALOG ERROR")) D
.S CNT=CNT+1,TEXT(CNT,0)="",CNT=CNT+1,TEXT(CNT,0)="The following dialog(s) had an error in the update process."
.S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN)) Q:IEN'>0 D
..S NAME=$P($G(^PXRMD(801.41,IEN,0)),U) I NAME="" Q
..S ARRAY(IEN)=""
..S CNT=CNT+1,TEXT(CNT,0)=" "_NAME
..I $D(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN,"CODE")) D
...S CNT=CNT+1,TEXT(CNT,0)=" List of pre-conversion codes below:"
...S CODESYS="" F S CODESYS=$O(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN,"CODE",CODESYS)) Q:CODESYS="" D
....S CODE="" F S CODE=$O(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN,"CODE",CODESYS,CODE)) Q:CODE="" D
.....S CNT=CNT+1,TEXT(CNT,0)=" "_CODESYS_": "_CODE
..I $D(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN,"ERROR")) S CNT=CNT+1,TEXT(CNT,0)=" "_$G(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN,"ERROR"))
;
I $D(^XTMP(PXRMXTMP,"TAXONOMY ERROR")) D
.S CNT=CNT+1,TEXT(CNT,0)="",CNT=CNT+1,TEXT(CNT,0)="The following taxonomies are missing codes."
.S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN)) Q:IEN'>0 D
..S NAME=$P($G(^PXD(811.2,IEN,0)),U) I NAME="" Q
..S CNT=CNT+1,TEXT(CNT,0)=" "_NAME
..S CNT=CNT+1,TEXT(CNT,0)=" List of pre-conversion codes below:"
..S CODESYS="" F S CODESYS=$O(^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN,"CODE",CODESYS)) Q:CODESYS="" D
...S CODE="" F S CODE=$O(^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN,"CODE",CODESYS,CODE)) Q:CODE="" D
....S CNT=CNT+1,TEXT(CNT,0)=" "_CODESYS_": "_CODE
;
S FIRST=1
S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,"DIALOG",IEN)) Q:IEN'>0 D
.I $G(^XTMP(PXRMXTMP,"DIALOG",IEN,"DONE"))=1 Q
.I $D(ARRAY(IEN)) Q
.S NAME=$P($G(^PXRMD(801.41,IEN,0)),U) I NAME="" Q
.I FIRST=1 D
..S CNT=CNT+1,TEXT(CNT,0)="",CNT=CNT+1,TEXT(CNT,0)="The following dialogs took an error in UPDATE^DIE.",FIRST=0
.S CNT=CNT+1,TEXT(CNT,0)=" "_NAME
;
I CNT>1 D
.K ^TMP("PXRMERRM")
.M ^TMP("PXRMERRM",$J)=TEXT
.D SEND^PXRMMSG("PXRMERRM","Clinical Reminder Patch 26 Errors.")
;
;D MES^XPDUTL(.TEXT)
;D MES^XPDUTL(.TEXT)
Q
;
PXRMP26D ;SLC/AGP - Dialog Conversion for PXRM*2.0*26. ;05/07/2014
+1 ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
+2 QUIT
+3 ;
+4 ;this code is used to add prompts to a dialog from file 801.45. This
+5 ;should only be called when an existing dialog contains a taxonomy
+6 ;and prompts are not set in the dialog.
PROMPTS(DIEN,SEL,DEFAULT,IENCNT,FDA) ;
+1 NEW CNT,CODE,DIR,DNUM,ENC,FIELD,IEN,IENS,NAME,NODE,NUM,PROMPT,PROMPTS,START,VALUE,Y
+2 ;
+3 ;if prompts already defined then Quit keeps existing functionality
+4 ;in sync prompts at element level override prompts for taxonomy
+5 DO MES^XPDUTL("Adding prompts to the dialog.")
+6 SET START=+$ORDER(^PXRMD(801.41,DIEN,10,""),-1)
IF START>0
QUIT
+7 ;
+8 SET CODE=""
FOR
SET CODE=$ORDER(DEFAULT(CODE))
IF CODE=""
QUIT
Begin DoDot:1
+9 IF SEL="P"
IF CODE="POV"
QUIT
+10 IF SEL="D"
IF CODE="CPT"
QUIT
+11 SET CNT=0
FOR
SET CNT=$ORDER(DEFAULT(CODE,"ADDFIND",CNT))
IF CNT'>0
QUIT
Begin DoDot:2
+12 SET NODE=DEFAULT(CODE,"ADDFIND",CNT)
+13 SET IEN=$PIECE(NODE,U)
+14 IF $DATA(^PXRMD(801.41,DIEN,10,"D",IEN))>0
QUIT
+15 IF $DATA(PROMPTS(IEN))>0
IF $LENGTH(PROMPTS(IEN),U)<$LENGTH(NODE,U)
SET PROMPTS(IEN)=NODE
+16 SET PROMPTS(IEN)=NODE
End DoDot:2
End DoDot:1
+17 ;
+18 IF '$DATA(PROMPTS)
QUIT
+19 SET START=+$ORDER(^PXRMD(801.41,DIEN,10,""),-1)
+20 SET DNUM=0
+21 SET IEN=0
SET CNT=0
FOR
SET IEN=$ORDER(PROMPTS(IEN))
IF IEN'>0
QUIT
Begin DoDot:1
+22 SET CNT=CNT+1
SET START=START+1
SET DNUM=DNUM+1
+23 SET IENCNT=IENCNT+1
SET IENS="+"_IENCNT_","_DIEN_","
+24 ;S IENCNT=IENCNT+1,IENS="+"_IENCNT_",1,"
+25 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+26 SET NODE=PROMPTS(IEN)
SET CNT=$LENGTH(NODE,U)
+27 IF $PIECE(NODE,U,3)>0
QUIT
+28 SET FDA(801.412,IENS,.01)=START
+29 SET FDA(801.412,IENS,2)=IEN
+30 IF CNT=1
QUIT
+31 FOR NUM=2:1:CNT
Begin DoDot:2
+32 IF NUM=3
QUIT
+33 IF NUM=4
QUIT
+34 SET VALUE=$PIECE(NODE,U,NUM)
IF $GET(VALUE)=""
QUIT
+35 SET FIELD=$SELECT(NUM=2:9,NUM=4:.01,NUM=5:6,NUM=6:7,NUM=7:8,1:"")
IF $GET(FIELD)=""
QUIT
+36 SET FDA(801.412,IENS,FIELD)=VALUE
End DoDot:2
End DoDot:1
+37 QUIT
+38 ;
+39 ;this is used to add a taxonomy to a finding in a dialog. Set field
+40 ;123 to N this should keep the functionality to the same as pre-ICD10
+41 ;functionality.
ADDFIND(DIEN,TAX,UPD,DEFAULT,IENCNT,FDA) ;
+1 NEW TNAME
+2 SET TNAME=$PIECE(^PXD(811.2,TAX,0),U)
+3 DO MES^XPDUTL("Adding Taxonomy "_TNAME_" as a Finding Item.")
+4 NEW IENS
+5 SET IENS=DIEN_","
+6 SET FDA(801.41,IENS,15)=TAX_";PXD(811.2,"
+7 IF UPD=2
SET FDA(801.41,IENS,123)="N"
QUIT
+8 ;S FDA(801.41,IENS,123)="A"
+9 ;I UPD=0 D ADDPROMPT(DIEN,TAX,.DEFAULT,.IENCNT,.FDA)
+10 QUIT
+11 ;
ADDFIND1(DIEN,TAX,DEFAULT,IENCNT,FDA) ;
+1 ;additional finding addition does not add prompts to the dialog.
+2 ;this should keep existing functionality in place
+3 ;may need a decision on this
+4 NEW TNAME
+5 SET TNAME=$PIECE(^PXD(811.2,TAX,0),U)
+6 DO MES^XPDUTL("Adding Taxonomy "_TNAME_" as an Additional Finding Item.")
+7 NEW IENS
+8 SET IENCNT=IENCNT+1
SET IENS="+"_IENCNT_","_DIEN_","
+9 ;S IENCNT=IENCNT+1,IENS="?+"_IENCNT_",1,"
+10 SET FDA(801.4118,IENS,.01)=TAX_";PXD(811.2,"
+11 QUIT
+12 ;
+13 ;This is used to pulled the default taxonomy field values from 801.45
+14 ; into 801.41 when updating a dialog that contains a taxonomy.
ADDTAXFL(DIEN,TAX,CODE,DEFAULT,IENCNT,FDA) ;
+1 ;D MES^XPDUTL("Adding default Taxonomy Field Values for "_CODE_".")
+2 DO MES^XPDUTL("Adding default Header Text for "_CODE_".")
+3 NEW ENCTYPE,IENS,NODEIEN,RESULT,TEMP,VALUE,X
+4 SET VALUE=$$ADDTAXF1^PXRMDTAX(CODE,.DEFAULT)
+5 SET X=$SELECT(CODE="POV":141,1:142)
+6 SET IENS=DIEN_","
+7 SET FDA(801.41,IENS,X)=VALUE
+8 QUIT
+9 ;
+10 ;use to build an array of codes to create a taxonomy from
BLDARRAY(DIEN,ARRAY,TCNT,TEXT) ;
+1 NEW CLASS,CNT,CODESYSN,CODESYS,FNUM,IEN,NAME,TEMP
+2 SET CNT=0
+3 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+4 SET TCNT=TCNT+1
SET TEXT(TCNT)="Dialog "_NAME_" Pre-conversion codes"
+5 FOR CODESYS="ICD9(","ICPT("
Begin DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,"DIALOG",DIEN,CODESYS,IEN))
IF IEN'>0
QUIT
Begin DoDot:2
+7 SET CODESYSN=$SELECT(CODESYS[9:"ICD",1:"CPT")
+8 SET CNT=CNT+1
SET ARRAY("CODE",CODESYSN,IEN)="I"_U_1
+9 SET TCNT=TCNT+1
SET TEXT(TCNT)=" "_$SELECT(CODESYSN="ICD":"Diagnosis Code",1:"Procedure Code")_": "_$$GET1^DIQ($SELECT(CODESYSN="ICD":80,1:81),IEN,.01)
End DoDot:2
End DoDot:1
+10 IF CNT=0
QUIT
+11 SET TCNT=TCNT+1
SET TEXT(TCNT)=""
+12 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+13 SET CLASS=$PIECE($GET(^PXRMD(801.41,DIEN,100)),U)
+14 IF CLASS="N"
SET NAME=$PIECE(NAME,"-",2)
SET CLASS="L"
+15 SET TEMP=$$RTAXNAME^PXRMDUTL(NAME)
+16 SET ARRAY("NAME")=TEMP
+17 SET ARRAY("COUNT")=CNT
+18 SET ARRAY("CLASS")=CLASS
+19 SET ARRAY("SOURCE")="Reminder Dialog IEN: "_DIEN
+20 QUIT
+21 ;
BLDTAXC(TEXT,TCNT,TIEN,DIEN) ;
+1 NEW ARRAY,CNT,CODESYS,DNAME,TNAME,X
+2 SET TNAME=$PIECE(^PXD(811.2,TIEN,0),U)
+3 SET DNAME=$PIECE(^PXRMD(801.41,DIEN,0),U)
+4 SET TCNT=TCNT+1
SET TEXT(TCNT)="Taxonomy "_TNAME_" added to dialog."
+5 SET TCNT=TCNT+1
SET TEXT(TCNT)="Taxonomy "_TNAME_" post-conversion codes list:"
+6 FOR X="POV","CPT"
Begin DoDot:1
+7 KILL CODESYS,ARRAY
+8 DO BLDCODE^PXRMDTAX(X,.CODESYS)
DO CODES^PXRMDLLB(TIEN,.CODESYS,.ARRAY)
+9 SET CNT=0
FOR
SET CNT=$ORDER(ARRAY(CNT))
IF CNT'>0
QUIT
SET TCNT=TCNT+1
SET TEXT(TCNT)=" "_$SELECT(X="POV":"Diagnosis Code",1:"Procedure Code")_": "_$PIECE($PIECE(ARRAY(CNT),U,2),":")
End DoDot:1
+10 QUIT
+11 ;create new taxonomy from dialog findings/additional findings,
+12 ;trap errors, and store new taxonomy and codes
CREATE(ARRAY,DIEN,TCNT,TEXT) ;
+1 NEW CNT,IEN,CODESYS,CODE,ERR
+2 SET IEN=$$CRETAX^PXRMTXIM("",.ARRAY,.ERR)
+3 IF $DATA(ERR)
Begin DoDot:1
+4 IF IEN=0
Begin DoDot:2
+5 SET TCNT=TCNT+1
SET TEXT(TCNT)="ERROR: A taxonomy could not be created"
+6 SET ^XTMP(PXRMXTMP,"DIALOG ERROR",DIEN,"ERROR")="Could not create a taxonomy. Dialog had the following codes assigned:"
+7 ;S ^XTMP(PXRMXTMP,"DIALOG ERROR",DIEN,"ERROR","DIALOG IEN")=DIEN
+8 MERGE ^XTMP(PXRMXTMP,"DIALOG ERROR",DIEN,"ERROR","CODE")=ARRAY("CODE")
End DoDot:2
QUIT
+9 IF IEN>0
Begin DoDot:2
+10 SET TCNT=TCNT+1
SET TEXT(TCNT)="ERROR: failed to add all the codes to the Taxonomy "_ARRAY("NAME")
+11 SET ^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN,"ERROR")="Could not add the following codes to the Taxonomy "_ARRAY("NAME")
+12 MERGE ^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN,"ERROR","CODE")=ERR
+13 ;S ^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN,"ERROR","TAXIEN")=IEN
End DoDot:2
End DoDot:1
+14 IF IEN=0
QUIT 0
+15 SET ^XTMP(PXRMXTMP,"TAXONOMY",IEN)=""
+16 SET ^XTMP(PXRMXTMP,"TAXONOMY",IEN,"NAME")=ARRAY("NAME")
KILL ARRAY("NAME")
+17 SET ^XTMP(PXRMXTMP,"TAXONOMY",IEN,"COUNT")=ARRAY("COUNT")
KILL ARRAY("COUNT")
+18 MERGE ^XTMP(PXRMXTMP,"TAXONOMY",IEN,"DATA")=ARRAY("CODE")
+19 DO BLDTAXC(.TEXT,.TCNT,IEN,DIEN)
+20 QUIT IEN
+21 ;
+22 ;determine if a new taxonomy needs to be use or if new taxonomy
+23 ;already exist
CRETAX ;
+1 NEW ARRAY,CNT,DIEN,FIND,HASCODE,IEN,NAME,TAX,TCNT,TEXT,TYPE
+2 DO MES^XPDUTL(" ")
+3 DO MES^XPDUTL("Dialogs updates")
+4 SET DIEN=0
FOR
SET DIEN=$ORDER(^XTMP(PXRMXTMP,"DIALOG",DIEN))
IF DIEN'>0
QUIT
Begin DoDot:1
+5 IF $GET(^XTMP(PXRMXTMP,"DIALOG",DIEN,"DONE"))=1
QUIT
+6 KILL ARRAY,TEXT
+7 SET TCNT=0
+8 DO BLDARRAY(DIEN,.ARRAY,.TCNT,.TEXT)
IF '$DATA(ARRAY)
QUIT
+9 SET TAX=$$TAXEXIST(.ARRAY,DIEN,.TCNT,.TEXT)
IF TAX>0
SET ^XTMP(PXRMXTMP,"DIALOG",DIEN,"PXD(811.2,",TAX)=2
+10 IF TAX<1
SET TAX=$$CREATE(.ARRAY,DIEN,.TCNT,.TEXT)
IF TAX>0
SET ^XTMP(PXRMXTMP,"DIALOG",DIEN,"PXD(811.2,",TAX)=2
+11 SET TCNT=TCNT+1
SET TEXT(TCNT)=""
+12 DO MES^XPDUTL(.TEXT)
End DoDot:1
+13 QUIT
+14 ;
+15 ;DEBUG CODE del to make clean-up easier for errors while in development
DELXTMP ;
+1 NEW ARRAY,DIEN,FIND,PXRMXTMP,TEMP,TIEN
+2 SET PXRMXTMP="PXRM DIALOG CONVERSION"
SET TEMP="DIALOG"
SET FIND="PXD(811.2,"
+3 SET DIEN=0
FOR
SET DIEN=$ORDER(^XTMP(PXRMXTMP,TEMP,DIEN))
IF DIEN'>0
QUIT
Begin DoDot:1
+4 SET TIEN=0
FOR
SET TIEN=$ORDER(^XTMP(PXRMXTMP,TEMP,DIEN,FIND,TIEN))
IF TIEN'>0
QUIT
Begin DoDot:2
+5 IF +$GET(^XTMP(PXRMXTMP,TEMP,DIEN,FIND,TIEN))=2
SET ARRAY(DIEN,TIEN)=""
End DoDot:2
End DoDot:1
+6 SET DIEN=0
FOR
SET DIEN=$ORDER(ARRAY(DIEN))
IF DIEN'>0
QUIT
Begin DoDot:1
+7 SET TIEN=0
FOR
SET TIEN=$ORDER(ARRAY(DIEN,TIEN))
IF TIEN'>0
QUIT
Begin DoDot:2
+8 KILL ^XTMP(PXRMXTMP,TEMP,DIEN,FIND,TIEN)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
+11 ;build edit history from FDA array.
EDITDES(DIEN,FDA,WP) ;
+1 NEW CNT
+2 SET CNT=1
+3 DO MES^XPDUTL("Updating edit history of the dialog.")
+4
*** ERROR ***
IF $g(FDA(801.41,DIEN_",",13))'=""
SET CNT=CNT+1
SET WP(CNT,0)=" Set Resolution Type to Done Elsewhere (Historical)"
+5 IF $GET(FDA(801.41,DIEN_",",15))'=""
SET CNT=CNT+1
SET WP(CNT,0)=" Updated Finding Item Field"
+6 IF $GET(FDA(801.41,DIEN_",",123))'=""
SET CNT=CNT+1
SET WP(CNT,0)=" Updated Taxonomy Selection Field to "_$GET(FDA(801.41,DIEN_",",123))
+7 IF $GET(FDA(801.41,DIEN_",",141))'=""
SET CNT=CNT+1
SET WP(CNT,0)=" Updated Diagnosis Header Text"
+8 IF $GET(FDA(801.41,DIEN_",",142))'=""
SET CNT=CNT+1
SET WP(CNT,0)=" Updated Diagnosis Header Text"
+9 ;I $D(FDA(801.46)) S CNT=CNT+1,WP(CNT,0)=" Update Taxonomy Fields"
+10 IF $DATA(FDA(801.4118))
SET CNT=CNT+1
SET WP(CNT,0)=" Update Additional Finding Item Multiple"
+11 IF $DATA(FDA(801.412))
SET CNT=CNT+1
SET WP(CNT,0)=" Added prompts to the dialog"
+12 IF CNT=1
SET CNT=CNT+1
SET WP(CNT,0)=" Nothing"
+13 QUIT
+14 ;
+15 ;loops through the xtmp of taxonomy determine the update path
GETLIST ;
+1 NEW ADDFVPL,CPTSTATUS,DIEN,FINDFVPL,IEN,POVSTATUS,TAXNEEDS,UPDTYPE,VALUE
+2 KILL ^TMP("PXRMXMZ",$JOB)
+3 DO BLDRLIST^PXRMVPTR(801.41,15,.FINDFVPL)
+4 DO BLDRLIST^PXRMVPTR(801.4118,.01,.ADDFVPL)
+5 SET CPTSTATUS=$$GETSTAT^PXRMDTAX("CPT")
SET POVSTATUS=$$GETSTAT^PXRMDTAX("POV")
+6 KILL ^TMP("PXRMXMZ",$JOB)
+7 SET ^TMP("PXRMXMZ",$JOB,1,0)="Dialog post-conversion report:"
+8 SET DIEN=0
FOR
SET DIEN=$ORDER(^XTMP(PXRMXTMP,"DIALOG",DIEN))
IF DIEN'>0
QUIT
Begin DoDot:1
+9 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,"DIALOG",DIEN,"PXD(811.2,",IEN))
IF IEN'>0
QUIT
Begin DoDot:2
+10 SET UPDTYPE=^XTMP(PXRMXTMP,"DIALOG",DIEN,"PXD(811.2,",IEN)
+11 SET TAXNEEDS=0
+12 IF $GET(^XTMP(PXRMXTMP,"DIALOG",DIEN,"DONE"))'=1
DO UPDATE(DIEN,IEN,UPDTYPE,CPTSTATUS,POVSTATUS,.TAXNEEDS)
+13 DO BLDTXT^PXRMP26X(DIEN,.FINDFVPL,.ADDFVPL,TAXNEEDS,0)
End DoDot:2
End DoDot:1
+14 IF $ORDER(^TMP("PXRMXMZ",$JOB,""),-1)>1
DO SEND^PXRMMSG("PXRMXMZ","Clinical Reminder Patch 26 Post-conversion dialog.")
+15 ;K ^TMP("PXRMXMZ",$J)
+16 QUIT
+17 ;
PRE ;
+1 ;I $$PATCH^XPDUTL("PXRM*2.0*26") Q
+2 NEW PXRMXTMP,PXRMSKIP
+3 SET PXRMXTMP="PXRM DIALOG CONVERSION"
+4 KILL ^XTMP(PXRMXTMP)
+5 SET ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"PXRM Patch 26 Dialog Conversion"
+6 SET PXRMSKIP("VA-WH PAP SMEAR OBTAINED")=""
SET PXRMSKIP("VA-GP AAA PRIOR DIAGNOSIS")=""
+7 SET PXRMSKIP("VA-IM FLU H1N1 DONE (1 DOSE)")=""
SET PXRMSKIP("VA-IM FLU H1N1 OUTSIDE (1 DOSE)")=""
+8 SET PXRMSKIP("VA-IM FLU HIGH DOSE DONE")=""
SET PXRMSKIP("VA-IM FLU HIGH DOSE OUTSIDE")=""
+9 DO BLDLIST^PXRMP26X(.PXRMSKIP)
+10 QUIT
+11 ;
POST ;
+1 ;I $$PATCH^XPDUTL("PXRM*2.0*26") Q
+2 KILL ^TMP($JOB,"PXRM TAX"),^TMP("PXRM DIALOG UPD",$JOB),^TMP("PXRM DIALOG STR",$JOB)
+3 NEW PXRMXTMP
+4 SET PXRMXTMP="PXRM DIALOG CONVERSION"
+5 DO CRETAX
+6 DO GETLIST
+7 DO WRITE
+8 DO MAKNAT(801.41,"ADD TO PROBLEM LIST","PXRM FV ADD TO PROBLEM LIST")
+9 DO RENAME^PXRMUTIL(801.41,"VA-ECOE DX LIST","VA-ECOE DX GROUP")
+10 ;K ^XTMP(PXRMXTMP),^TMP($J,"PXRM TAX"),^TMP("PXRM DIALOG UPD",$J),^TMP("PXRM DIALOG STR",$J)
+11 KILL ^TMP($JOB,"PXRM TAX"),^TMP("PXRM DIALOG UPD",$JOB),^TMP("PXRM DIALOG STR",$JOB)
+12 QUIT
+13 ;
MAKNAT(FILENUM,OLDNAME,NEWNAME) ;Rename entry OLDNAME to NEWNAME in
+1 ;file number FILENUM.
+2 NEW DA,DIE,DR,NIEN,PXRMINST,TEXT
+3 SET DA=$$FIND1^DIC(FILENUM,"","BXU",OLDNAME)
+4 IF DA=0
QUIT
+5 SET PXRMINST=1
+6 SET NIEN=$$FIND1^DIC(FILENUM,"","BXU",NEWNAME)
IF NIEN>0
QUIT
+7 SET DIE=FILENUM
+8 SET DR=".01///^S X=NEWNAME;100///N"
+9 DO ^DIE
+10 SET TEXT(1)="Converting "_OLDNAME_" IEN: "_DA
SET TEXT(2)="to national value "_NEWNAME
+11 DO MES^XPDUTL(.TEXT)
+12 QUIT
+13 ;
+14 ;compare array with new taxonomies already created if one matches the
+15 ;array returns that taxonomy IEN
TAXEXIST(ARRAY,DIEN,TCNT,TEXT) ;
+1 NEW CIEN,CODESYS,FAIL,IEN,MATCH,RESULT,EDATE,SDATE,TAX,TYPE
+2 SET RESULT=0
SET MATCH=0
+3 SET TAX=0
FOR
SET TAX=$ORDER(^XTMP(PXRMXTMP,"TAXONOMY",TAX))
IF TAX'>0!(MATCH=1)
QUIT
Begin DoDot:1
+4 IF ^XTMP(PXRMXTMP,"TAXONOMY",TAX,"COUNT")'=ARRAY("COUNT")
QUIT
+5 SET FAIL=0
+6 SET TYPE=""
FOR
SET TYPE=$ORDER(^XTMP(PXRMXTMP,"TAXONOMY",TAX,"DATA",TYPE))
IF TYPE=""!(FAIL=1)
QUIT
Begin DoDot:2
+7 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,"TAXONOMY",TAX,"DATA",TYPE,IEN))
IF IEN'>0!(FAIL=1)
QUIT
Begin DoDot:3
+8 IF '$DATA(ARRAY("CODE",TYPE,IEN))
SET FAIL=1
QUIT
End DoDot:3
End DoDot:2
+9 IF FAIL=0
SET RESULT=TAX
SET MATCH=1
DO BLDTAXC(.TEXT,.TCNT,RESULT,DIEN)
End DoDot:1
+10 QUIT RESULT
+11 ;
+12 ;determine what updates are needed for the Taxonomy
+13 ; add taxonomy as a finding item/additional finding item if prompts
+14 ;should be added
+15 ; calls UPDATE^DIE
UPDATE(DIEN,TAX,UPDTYPE,CPTSTATUS,POVSTATUS,TAXNEEDS) ;
+1 NEW CLASS,DEFAULT,DNAME,FDA,FIND,IENCNT,IENROOT,IENS,MSG,NAME,SAME,START,TEXT,TDX,TPR,TYPE,TAXSEL
+2 SET DNAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+3 DO MES^XPDUTL("Updating record for dialog "_DNAME_" IEN: "_DIEN)
+4 SET IENROOT(1)=DIEN
+5 SET TDX=$$TOK^PXRMDTAX(TAX,"POV")
+6 SET TPR=$$TOK^PXRMDTAX(TAX,"CPT")
+7 IF TDX=1
DO GETTAXDF^PXRMDTAX(.DEFAULT,"POV",$SELECT(POVSTATUS=2:1,1:0))
+8 IF TPR=1
DO GETTAXDF^PXRMDTAX(.DEFAULT,"CPT",$SELECT(CPTSTATUS=2:1,1:0))
+9 IF TDX=0
IF TPR=0
Begin DoDot:1
+10 SET ^XTMP(PXRMXTMP,"DIALOG ERROR",DIEN,"ERROR")="A taxonomy does not have codes marked to be used in a dialog."
End DoDot:1
QUIT
+11 SET IENCNT=DIEN
+12 ;
+13 SET FIND=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)
IF FIND'=""
Begin DoDot:1
+14 SET SAME=0
IF FIND[811.2
Begin DoDot:2
+15 ;if same find only add prompts if suppress prompts is null
+16 IF +FIND=TAX
Begin DoDot:3
+17 SET SAME=1
+18 IF UPDTYPE<2
Begin DoDot:4
+19 SET TAXSEL="N"
+20 IF TPR=1
SET TAXSEL="P"
IF POVSTATUS=2
SET FDA(801.41,DIEN_",",13)="2"
+21 IF TDX=1
SET TAXSEL="D"
IF CPTSTATUS=2
SET FDA(801.41,DIEN_",",13)="2"
+22 IF TPR=1
IF TDX=1
Begin DoDot:5
+23 KILL FDA(801.41,DIEN_",",13)
+24 SET TAXSEL="A"
+25 IF CPTSTATUS=POVSTATUS
IF POVSTATUS=2
SET FDA(801.41,DIEN_",",13)="2"
QUIT
+26 IF CPTSTATUS'=POVSTATUS
SET TAXNEEDS=1
End DoDot:5
+27 SET FDA(801.41,DIEN_",",123)=TAXSEL
+28 IF TDX=1
DO ADDTAXFL(DIEN,TAX,"POV",.DEFAULT,.IENCNT,.FDA)
+29 IF TPR=1
DO ADDTAXFL(DIEN,TAX,"CPT",.DEFAULT,.IENCNT,.FDA)
End DoDot:4
+30 IF UPDTYPE=1
DO PROMPTS(DIEN,TAXSEL,.DEFAULT,.IENCNT,.FDA)
End DoDot:3
QUIT
End DoDot:2
+31 IF SAME=1
QUIT
+32 DO ADDFIND1(DIEN,TAX,.DEFAULT,.IENCNT,.FDA)
End DoDot:1
GOTO UPDATEX
+33 ;
+34 DO ADDFIND(DIEN,TAX,UPDTYPE,.DEFAULT,.IENCNT,.FDA)
+35 ;
UPDATEX ;
+1 ;populate edit history
+2 NEW WP
+3 SET WP(1,0)="Reminder Code Conversion Routine did the following:"
+4 DO EDITDES(DIEN,.FDA,.WP)
+5 ;S IENCNT=IENCNT+1,IENS="+"_IENCNT_","_DIEN_","
+6 SET IENCNT=IENCNT+1
SET IENS="+"_IENCNT_","_DIEN_","
+7 SET FDA(801.44,IENS,.01)=DT
+8 SET FDA(801.44,IENS,1)=DUZ
+9 SET FDA(801.44,IENS,2)="WP"
+10 ;populate required fields from existing entry
+11 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+12 SET CLASS=$PIECE($GET(^PXRMD(801.41,DIEN,100)),U)
+13 SET TYPE=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)
+14 ;
+15 SET FDA(801.41,DIEN_",",.01)=NAME
+16 SET FDA(801.41,DIEN_",",4)=TYPE
+17 SET FDA(801.41,DIEN_",",100)=CLASS
+18 DO UPDATE^DIE("","FDA","","MSG")
+19 IF '$DATA(MSG)
SET ^XTMP(PXRMXTMP,"DIALOG",DIEN,"DONE")=1
+20 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
+21 SET ^XTMP(PXRMXTMP,"DIALOG UPDATED",DIEN)=1
+22 DO MES^XPDUTL("Completed record updates for dialog "_DNAME_" IEN: "_DIEN)
+23 DO MES^XPDUTL(" ")
+24 QUIT
+25 ;
+26 ;DEBUG CODE to be deleted
WRITENAM ;
+1 NEW NAME,PXRMXTMP,TEMP,DIEN
+2 SET PXRMXTMP="PXRM DIALOG CONVERSION"
SET TEMP="DIALOG"
+3 SET DIEN=0
FOR
SET DIEN=$ORDER(^XTMP(PXRMXTMP,TEMP,DIEN))
IF DIEN'>0
QUIT
Begin DoDot:1
+4 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+5 IF NAME["WAT"
Begin DoDot:2
+6 KILL ^XTMP(PXRMXTMP,TEMP,DIEN,"ICD9(")
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
+9 ;write out the final overview when the updates are done
WRITE ;
+1 NEW ARRAY,CNT,FIRST,IEN,NAME,NODE,TEXT,CODESYS,CODE
+2 SET CNT=0
+3 DO MES^XPDUTL("Overview")
+4 IF $DATA(^XTMP(PXRMXTMP,"TAXONOMY"))>0
Begin DoDot:1
+5 SET CNT=0
+6 ;S CNT=CNT+1,TEXT(CNT)="The following Taxonomies were created:"
+7 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,"TAXONOMY",IEN))
IF IEN'>0
QUIT
SET CNT=CNT+1
+8 IF CNT>0
DO MES^XPDUTL("Created "_CNT_" taxonomies")
End DoDot:1
+9 ;
+10 IF $DATA(^XTMP(PXRMXTMP,"DIALOG UPDATED"))>0
Begin DoDot:1
+11 SET CNT=0
+12 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,"DIALOG UPDATED",IEN))
IF IEN'>0
QUIT
SET CNT=CNT+1
+13 IF CNT>0
DO MES^XPDUTL("Updated "_CNT_" dialogs")
End DoDot:1
+14 IF '$DATA(^XTMP(PXRMXTMP,"DIALOG UPDATED"))
IF $DATA(^XTMP(PXRMXTMP,"TAXONOMY ERROR"))
DO MES^XPDUTL("No errors found")
QUIT
+15 SET CNT=1
+16 ;
+17 SET TEXT(CNT,0)="Manual Correction is needed for the following items"
+18 IF $DATA(^XTMP(PXRMXTMP,"DIALOG ERROR"))
Begin DoDot:1
+19 SET CNT=CNT+1
SET TEXT(CNT,0)=""
SET CNT=CNT+1
SET TEXT(CNT,0)="The following dialog(s) had an error in the update process."
+20 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN))
IF IEN'>0
QUIT
Begin DoDot:2
+21 SET NAME=$PIECE($GET(^PXRMD(801.41,IEN,0)),U)
IF NAME=""
QUIT
+22 SET ARRAY(IEN)=""
+23 SET CNT=CNT+1
SET TEXT(CNT,0)=" "_NAME
+24 IF $DATA(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN,"CODE"))
Begin DoDot:3
+25 SET CNT=CNT+1
SET TEXT(CNT,0)=" List of pre-conversion codes below:"
+26 SET CODESYS=""
FOR
SET CODESYS=$ORDER(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN,"CODE",CODESYS))
IF CODESYS=""
QUIT
Begin DoDot:4
+27 SET CODE=""
FOR
SET CODE=$ORDER(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN,"CODE",CODESYS,CODE))
IF CODE=""
QUIT
Begin DoDot:5
+28 SET CNT=CNT+1
SET TEXT(CNT,0)=" "_CODESYS_": "_CODE
End DoDot:5
End DoDot:4
End DoDot:3
+29 IF $DATA(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN,"ERROR"))
SET CNT=CNT+1
SET TEXT(CNT,0)=" "_$GET(^XTMP(PXRMXTMP,"DIALOG ERROR",IEN,"ERROR"))
End DoDot:2
End DoDot:1
+30 ;
+31 IF $DATA(^XTMP(PXRMXTMP,"TAXONOMY ERROR"))
Begin DoDot:1
+32 SET CNT=CNT+1
SET TEXT(CNT,0)=""
SET CNT=CNT+1
SET TEXT(CNT,0)="The following taxonomies are missing codes."
+33 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN))
IF IEN'>0
QUIT
Begin DoDot:2
+34 SET NAME=$PIECE($GET(^PXD(811.2,IEN,0)),U)
IF NAME=""
QUIT
+35 SET CNT=CNT+1
SET TEXT(CNT,0)=" "_NAME
+36 SET CNT=CNT+1
SET TEXT(CNT,0)=" List of pre-conversion codes below:"
+37 SET CODESYS=""
FOR
SET CODESYS=$ORDER(^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN,"CODE",CODESYS))
IF CODESYS=""
QUIT
Begin DoDot:3
+38 SET CODE=""
FOR
SET CODE=$ORDER(^XTMP(PXRMXTMP,"TAXONOMY ERROR",IEN,"CODE",CODESYS,CODE))
IF CODE=""
QUIT
Begin DoDot:4
+39 SET CNT=CNT+1
SET TEXT(CNT,0)=" "_CODESYS_": "_CODE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+40 ;
+41 SET FIRST=1
+42 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,"DIALOG",IEN))
IF IEN'>0
QUIT
Begin DoDot:1
+43 IF $GET(^XTMP(PXRMXTMP,"DIALOG",IEN,"DONE"))=1
QUIT
+44 IF $DATA(ARRAY(IEN))
QUIT
+45 SET NAME=$PIECE($GET(^PXRMD(801.41,IEN,0)),U)
IF NAME=""
QUIT
+46 IF FIRST=1
Begin DoDot:2
+47 SET CNT=CNT+1
SET TEXT(CNT,0)=""
SET CNT=CNT+1
SET TEXT(CNT,0)="The following dialogs took an error in UPDATE^DIE."
SET FIRST=0
End DoDot:2
+48 SET CNT=CNT+1
SET TEXT(CNT,0)=" "_NAME
End DoDot:1
+49 ;
+50 IF CNT>1
Begin DoDot:1
+51 KILL ^TMP("PXRMERRM")
+52 MERGE ^TMP("PXRMERRM",$JOB)=TEXT
+53 DO SEND^PXRMMSG("PXRMERRM","Clinical Reminder Patch 26 Errors.")
End DoDot:1
+54 ;
+55 ;D MES^XPDUTL(.TEXT)
+56 ;D MES^XPDUTL(.TEXT)
+57 QUIT
+58 ;
