RORP019 ;ALB/KG - CCR PRE/POST-INSTALL PATCH 19 ;3/12/12
;;1.5;CLINICAL CASE REGISTRIES;**19**;Feb 17, 2006;Build 43
;
; This routine uses the following IAs:
; #2263 ADD^XPAR (supported)
; #2263 DEL^XPAR (supported)
; FIND1^DIC (supported)
; #2053 UPDATE^DIE (supported)
; #10009 FILE^DICN (supported)
; #10018 ^DIE (supported)
; #10000 YMD^%DTC (supported)
; #5747 CODEABA^ICDEX (controlled)
; #5747 VSTD^ICDEX (controlled)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
;******************************************************************************
;******************************************************************************
;
Q
;Pre-Install routine for Patch 19
PRE ;
;Save existing Common Templates in a ^XTMP global and then delete them
D SAVETMPL
Q
;
;Post-Install routine for Patch 19
POST ;
N RORRULENAME,RORRULEIEN,RORRULEDESC,RORRULEFILE,RORRULEEXPR,RORHIVDXS,RORHEPCDXS
N RORREGNAME,RORREGIEN,RORRULENAMES,ROREXISTIEN,RORDATA,RORNUM,RORDXS,RORDX,RORICDIEN,ROREXISTICDIEN
;
;Updating existing Selection Rule records with Coding System
F RORRULENAME="VA HIV PROBLEM","VA HEPC PROBLEM","VA HIV PTF","VA HEPC PTF","VA HIV VPOV","VA HEPC VPOV" D
. S RORRULEIEN=$$SRLIEN^RORUTL02(RORRULENAME)
. Q:RORRULEIEN<0
. K DIE S DIE="^ROR(798.2,",DA=RORRULEIEN,DR="7////1"
. L +^ROR(798.2,RORRULEIEN):0 I $T D ^DIE L -^ROR(798.2,RORRULEIEN)
;
;Adding ICD-10 codes to ICD Search records (#798.5)
S RORHIVDXS="B20.,B97.35,Z21.,O98.711,O98.712,O98.713,O98.719,O98.72,O98.73"
S RORHEPCDXS="B17.10,B17.11,B18.2,B19.20,B19.21,Z22.52"
F RORREGNAME="VA HIV","VA HEPC" D
. S RORREGIEN=$$REGIEN^RORUTL02(RORREGNAME) ;IEN of #798.5 is same as IEN of #798.1
. S RORDXS=$S(RORREGNAME="VA HIV":RORHIVDXS,1:RORHEPCDXS)
. F RORNUM=1:1 S RORDX=$P(RORDXS,",",RORNUM) Q:RORDX="" D
. . S RORICDIEN=+$$CODEABA^ICDEX(RORDX,"",30)
. . Q:RORICDIEN<0
. . S ROREXISTICDIEN=$$FIND1^DIC(798.51,","_RORREGIEN_",","Q",RORICDIEN,"B")
. . Q:ROREXISTICDIEN'=0 ;quit if code is already assigned to rule
. . K RORDATA
. . S RORDATA(1,798.51,"+2,"_RORREGIEN_",",.01)=RORICDIEN
. . D UPDATE^DIE("","RORDATA(1)")
;
;Creating new Selection Rule records (#798.2)
S RORRULEDESC="ICD-10 code in problem list"
S RORRULEFILE="9000011"
S RORRULEEXPR="+$D(^ROR(798.5,REGIEN,1,""B"",+{I:DIAGNOSIS}))"
F RORRULENAME="VA HIV PROBLEM (ICD10)","VA HEPC PROBLEM (ICD10)" D
. D NEWRULE(RORRULENAME,RORRULEEXPR,RORRULEFILE,RORRULEDESC)
;
S RORRULEDESC="ICD-10 code in outpatient file"
S RORRULEFILE="9000010.07"
S RORRULEEXPR="+$D(^ROR(798.5,REGIEN,1,""B"",+{I:POV}))"
F RORRULENAME="VA HIV VPOV (ICD10)","VA HEPC VPOV (ICD10)" D
. D NEWRULE(RORRULENAME,RORRULEEXPR,RORRULEFILE,RORRULEDESC)
;
S RORRULEDESC="ICD-10 code in inpatient file"
S RORRULEFILE="45"
S RORRULEEXPR="$$PTFRULE^RORUPD09(REGIEN)"
F RORRULENAME="VA HIV PTF (ICD10)","VA HEPC PTF (ICD10)" D
. D NEWRULE(RORRULENAME,RORRULEEXPR,RORRULEFILE,RORRULEDESC)
;
;Updating existing Registry records with new Selection Rules
S RORRULENAMES("VA HIV","VA HIV PROBLEM (ICD10)")=""
S RORRULENAMES("VA HIV","VA HIV VPOV (ICD10)")=""
S RORRULENAMES("VA HIV","VA HIV PTF (ICD10)")=""
S RORRULENAMES("VA HEPC","VA HEPC PROBLEM (ICD10)")=""
S RORRULENAMES("VA HEPC","VA HEPC VPOV (ICD10)")=""
S RORRULENAMES("VA HEPC","VA HEPC PTF (ICD10)")=""
F RORREGNAME="VA HIV","VA HEPC" D
. S RORREGIEN=$$REGIEN^RORUTL02(RORREGNAME)
. Q:RORREGIEN<0 ;quit if registry doesn't exist
. S RORRULENAME=""
. F S RORRULENAME=$O(RORRULENAMES(RORREGNAME,RORRULENAME)) Q:RORRULENAME="" D
. . S RORRULEIEN=$$SRLIEN^RORUTL02(RORRULENAME)
. . Q:RORRULEIEN<0 ;quit if rule doesn't exist in 798.2
. . S ROREXISTIEN=$$FIND1^DIC(798.13,","_RORREGIEN_",","X",RORRULENAME,"B")
. . Q:ROREXISTIEN'=0 ;quit if rule is already assigned to registry
. . K RORDATA
. . S RORDATA(1,798.13,"+2,"_RORREGIEN_",",.01)=RORRULENAME
. . D UPDATE^DIE("","RORDATA(1)")
;
K DIE,DA,DR
;
;Build Common Templates with ICD-9 and ICD-10 codes
D UPDTMPL
;Remove ROR LIST ICD-9 from file #8994. It was replaced by ROR LIST ICD
N DIK,DA
S DIK="^XWB(8994,",DA=$O(^XWB(8994,"B","ROR LIST ICD-9","")) I 'DA Q
D ^DIK
Q
;
;Creating a new Selection Rule record in File #798.2
NEWRULE(NAME,EXPR,FILE,DESC) ;
N RORIEN
S RORIEN=$$SRLIEN^RORUTL02(NAME) ;check if rule already exists
I RORIEN<0 S DIC(0)="",DIC="^ROR(798.2,",X=NAME D FILE^DICN S RORIEN=$P(Y,U,1)
K DIC,X,Y
Q:RORIEN<0
L +^ROR(798.2,RORIEN):0
Q:'$T
K DIE S DIE="^ROR(798.2,",DA=RORIEN,DR=".09////1;1////"_EXPR_";2////"_FILE_";4////"_DESC_";7////30"
D ^DIE
L -^ROR(798.2,RORIEN)
K DIE,DA,DR
Q
;
;Save existing Common Templates in a ^XTMP global
SAVETMPL ;
N RORLST,RORDATE,%H,RORIPRT,RORBUF,RORENTITY,RORPARAM,RORINSTANCE,RORINSTNAME
;Save existing common templates in a ^XTMP global
S %H=+$H+180 D YMD^%DTC S RORDATE=X K X
S ^XTMP("RORP19",$J,0)=RORDATE_U_DT_U_"Backup of Common Templates in File 8989.5 by "_$G(DUZ)
S RORENTITY="PKG.CLINICAL CASE REGISTRIES"
S RORPARAM="ROR REPORT PARAMS TEMPLATE"
D GETPLIST^RORRP038(.RORLST,"ROR REPORT PARAMS TEMPLATE","PKG")
S RORIPRT=0
F S RORIPRT=$O(RORLST(RORIPRT)) Q:RORIPRT'>0 D
. S RORINSTANCE=$P(RORLST(RORIPRT),U,1)
. S RORINSTNAME=RORINSTANCE_U_"ROR REPORT PARAMS TEMPLATE"
. D GETPARM^RORRP038(.RORBUF,RORINSTNAME,"PKG")
. Q:$G(RORBUF(0))<0
. K RORBUF(0) Q:$D(RORBUF)<10
. ;save an existing common template
. S ^XTMP("RORP19",$J,RORIPRT)=RORINSTANCE
. M ^XTMP("RORP19",$J,RORIPRT)=RORBUF
. ;delete an existing common template
. D DEL^XPAR(RORENTITY,RORPARAM,RORINSTANCE)
Q
;
;Build Common Templates with ICD-9 and ICD-10 codes
UPDTMPL ;
N I,J,RORTMPL,RORVALUE,RORTYPE,RORENTITY,RORPARAM,RORGROUP,RORCNT,RORICDCODES,RORICDCODE,RORICDIEN,RORICDDESC
N RORVERSION,RORCSYS,ROREXTN
S RORENTITY="PKG.CLINICAL CASE REGISTRIES"
S RORPARAM="ROR REPORT PARAMS TEMPLATE"
F ROREXTN="A","B" D
. F I=1:1 S RORTMPL=$P($T(@("TMPLCODE+"_I_"^RORP019"_ROREXTN)),";;",2) Q:RORTMPL="" D
. . S RORTYPE=$P(RORTMPL,"^",1) ;1=XML Header, 2=ICD-9 codes, 3=ICD-10 codes, 9=XML Footer
. . I RORTYPE="1" D ;XML Header Info
. . . S RORGROUP=$P(RORTMPL,"^",2)
. . . S RORINSTANCE="13::"_RORGROUP
. . . S RORVALUE="CCR Predefined Report Template"
. . . S RORCNT=0
. . . S RORCNT=RORCNT+1,RORVALUE(RORCNT,0)="<?xml version="_"""1.0"""_" encoding="_"""UTF-8"""_"?>"
. . . S RORCNT=RORCNT+1,RORVALUE(RORCNT,0)="<PARAMS>"
. . . S RORCNT=RORCNT+1,RORVALUE(RORCNT,0)="<ICDLST>"
. . . S RORCNT=RORCNT+1,RORVALUE(RORCNT,0)="<GROUP ID="""_RORGROUP_""">"
. . I (RORTYPE="2")!(RORTYPE="3") D ;XML Body with ICD-9/ICD-10 codes
. . . S RORICDCODES=$P(RORTMPL,"^",2)
. . . F J=1:1 S RORICDCODE=$P(RORICDCODES,",",J) Q:RORICDCODE="" D
. . . . S RORCNT=RORCNT+1
. . . . S RORCSYS=$S(RORTYPE=2:"1",1:"30")
. . . . S RORICDIEN=$$CODEABA^ICDEX(RORICDCODE,"",RORCSYS)
. . . . Q:'(RORICDIEN>0)
. . . . S RORVERSION=$S(RORTYPE=2:"ICD-9",1:"ICD-10")
. . . . S RORICDDESC=$$XMLENC^RORUTL03($$VSTD^ICDEX(RORICDIEN))
. . . . S RORVALUE(RORCNT,0)="<ICD ID="""_RORICDCODE_""" VERSION="""_RORVERSION_""">"_RORICDDESC_"</ICD>"
. . I RORTYPE="9" D ;XML Footer Info
. . . S RORCNT=RORCNT+1,RORVALUE(RORCNT,0)="</GROUP>"
. . . S RORCNT=RORCNT+1,RORVALUE(RORCNT,0)="</ICDLST>"
. . . S RORCNT=RORCNT+1,RORVALUE(RORCNT,0)="<PANELS>"
. . . S RORCNT=RORCNT+1,RORVALUE(RORCNT,0)="<PANEL ID="_"""160"""_"/>"
. . . S RORCNT=RORCNT+1,RORVALUE(RORCNT,0)="</PANELS>"
. . . S RORCNT=RORCNT+1,RORVALUE(RORCNT,0)="</PARAMS>"
. . . D ADD^XPAR(RORENTITY,RORPARAM,RORINSTANCE,.RORVALUE)
. . . K RORVALUE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORP019 8212 printed Nov 22, 2024@16:52:39 Page 2
RORP019 ;ALB/KG - CCR PRE/POST-INSTALL PATCH 19 ;3/12/12
+1 ;;1.5;CLINICAL CASE REGISTRIES;**19**;Feb 17, 2006;Build 43
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #2263 ADD^XPAR (supported)
+5 ; #2263 DEL^XPAR (supported)
+6 ; FIND1^DIC (supported)
+7 ; #2053 UPDATE^DIE (supported)
+8 ; #10009 FILE^DICN (supported)
+9 ; #10018 ^DIE (supported)
+10 ; #10000 YMD^%DTC (supported)
+11 ; #5747 CODEABA^ICDEX (controlled)
+12 ; #5747 VSTD^ICDEX (controlled)
+13 ;
+14 ;******************************************************************************
+15 ;******************************************************************************
+16 ; --- ROUTINE MODIFICATION LOG ---
+17 ;
+18 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+19 ;----------- ---------- ----------- ----------------------------------------
+20 ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
+21 ;******************************************************************************
+22 ;******************************************************************************
+23 ;
+24 QUIT
+25 ;Pre-Install routine for Patch 19
PRE ;
+1 ;Save existing Common Templates in a ^XTMP global and then delete them
+2 DO SAVETMPL
+3 QUIT
+4 ;
+5 ;Post-Install routine for Patch 19
POST ;
+1 NEW RORRULENAME,RORRULEIEN,RORRULEDESC,RORRULEFILE,RORRULEEXPR,RORHIVDXS,RORHEPCDXS
+2 NEW RORREGNAME,RORREGIEN,RORRULENAMES,ROREXISTIEN,RORDATA,RORNUM,RORDXS,RORDX,RORICDIEN,ROREXISTICDIEN
+3 ;
+4 ;Updating existing Selection Rule records with Coding System
+5 FOR RORRULENAME="VA HIV PROBLEM","VA HEPC PROBLEM","VA HIV PTF","VA HEPC PTF","VA HIV VPOV","VA HEPC VPOV"
Begin DoDot:1
+6 SET RORRULEIEN=$$SRLIEN^RORUTL02(RORRULENAME)
+7 if RORRULEIEN<0
QUIT
+8 KILL DIE
SET DIE="^ROR(798.2,"
SET DA=RORRULEIEN
SET DR="7////1"
+9 LOCK +^ROR(798.2,RORRULEIEN):0
IF $TEST
DO ^DIE
LOCK -^ROR(798.2,RORRULEIEN)
End DoDot:1
+10 ;
+11 ;Adding ICD-10 codes to ICD Search records (#798.5)
+12 SET RORHIVDXS="B20.,B97.35,Z21.,O98.711,O98.712,O98.713,O98.719,O98.72,O98.73"
+13 SET RORHEPCDXS="B17.10,B17.11,B18.2,B19.20,B19.21,Z22.52"
+14 FOR RORREGNAME="VA HIV","VA HEPC"
Begin DoDot:1
+15 ;IEN of #798.5 is same as IEN of #798.1
SET RORREGIEN=$$REGIEN^RORUTL02(RORREGNAME)
+16 SET RORDXS=$SELECT(RORREGNAME="VA HIV":RORHIVDXS,1:RORHEPCDXS)
+17 FOR RORNUM=1:1
SET RORDX=$PIECE(RORDXS,",",RORNUM)
if RORDX=""
QUIT
Begin DoDot:2
+18 SET RORICDIEN=+$$CODEABA^ICDEX(RORDX,"",30)
+19 if RORICDIEN<0
QUIT
+20 SET ROREXISTICDIEN=$$FIND1^DIC(798.51,","_RORREGIEN_",","Q",RORICDIEN,"B")
+21 ;quit if code is already assigned to rule
if ROREXISTICDIEN'=0
QUIT
+22 KILL RORDATA
+23 SET RORDATA(1,798.51,"+2,"_RORREGIEN_",",.01)=RORICDIEN
+24 DO UPDATE^DIE("","RORDATA(1)")
End DoDot:2
End DoDot:1
+25 ;
+26 ;Creating new Selection Rule records (#798.2)
+27 SET RORRULEDESC="ICD-10 code in problem list"
+28 SET RORRULEFILE="9000011"
+29 SET RORRULEEXPR="+$D(^ROR(798.5,REGIEN,1,""B"",+{I:DIAGNOSIS}))"
+30 FOR RORRULENAME="VA HIV PROBLEM (ICD10)","VA HEPC PROBLEM (ICD10)"
Begin DoDot:1
+31 DO NEWRULE(RORRULENAME,RORRULEEXPR,RORRULEFILE,RORRULEDESC)
End DoDot:1
+32 ;
+33 SET RORRULEDESC="ICD-10 code in outpatient file"
+34 SET RORRULEFILE="9000010.07"
+35 SET RORRULEEXPR="+$D(^ROR(798.5,REGIEN,1,""B"",+{I:POV}))"
+36 FOR RORRULENAME="VA HIV VPOV (ICD10)","VA HEPC VPOV (ICD10)"
Begin DoDot:1
+37 DO NEWRULE(RORRULENAME,RORRULEEXPR,RORRULEFILE,RORRULEDESC)
End DoDot:1
+38 ;
+39 SET RORRULEDESC="ICD-10 code in inpatient file"
+40 SET RORRULEFILE="45"
+41 SET RORRULEEXPR="$$PTFRULE^RORUPD09(REGIEN)"
+42 FOR RORRULENAME="VA HIV PTF (ICD10)","VA HEPC PTF (ICD10)"
Begin DoDot:1
+43 DO NEWRULE(RORRULENAME,RORRULEEXPR,RORRULEFILE,RORRULEDESC)
End DoDot:1
+44 ;
+45 ;Updating existing Registry records with new Selection Rules
+46 SET RORRULENAMES("VA HIV","VA HIV PROBLEM (ICD10)")=""
+47 SET RORRULENAMES("VA HIV","VA HIV VPOV (ICD10)")=""
+48 SET RORRULENAMES("VA HIV","VA HIV PTF (ICD10)")=""
+49 SET RORRULENAMES("VA HEPC","VA HEPC PROBLEM (ICD10)")=""
+50 SET RORRULENAMES("VA HEPC","VA HEPC VPOV (ICD10)")=""
+51 SET RORRULENAMES("VA HEPC","VA HEPC PTF (ICD10)")=""
+52 FOR RORREGNAME="VA HIV","VA HEPC"
Begin DoDot:1
+53 SET RORREGIEN=$$REGIEN^RORUTL02(RORREGNAME)
+54 ;quit if registry doesn't exist
if RORREGIEN<0
QUIT
+55 SET RORRULENAME=""
+56 FOR
SET RORRULENAME=$ORDER(RORRULENAMES(RORREGNAME,RORRULENAME))
if RORRULENAME=""
QUIT
Begin DoDot:2
+57 SET RORRULEIEN=$$SRLIEN^RORUTL02(RORRULENAME)
+58 ;quit if rule doesn't exist in 798.2
if RORRULEIEN<0
QUIT
+59 SET ROREXISTIEN=$$FIND1^DIC(798.13,","_RORREGIEN_",","X",RORRULENAME,"B")
+60 ;quit if rule is already assigned to registry
if ROREXISTIEN'=0
QUIT
+61 KILL RORDATA
+62 SET RORDATA(1,798.13,"+2,"_RORREGIEN_",",.01)=RORRULENAME
+63 DO UPDATE^DIE("","RORDATA(1)")
End DoDot:2
End DoDot:1
+64 ;
+65 KILL DIE,DA,DR
+66 ;
+67 ;Build Common Templates with ICD-9 and ICD-10 codes
+68 DO UPDTMPL
+69 ;Remove ROR LIST ICD-9 from file #8994. It was replaced by ROR LIST ICD
+70 NEW DIK,DA
+71 SET DIK="^XWB(8994,"
SET DA=$ORDER(^XWB(8994,"B","ROR LIST ICD-9",""))
IF 'DA
QUIT
+72 DO ^DIK
+73 QUIT
+74 ;
+75 ;Creating a new Selection Rule record in File #798.2
NEWRULE(NAME,EXPR,FILE,DESC) ;
+1 NEW RORIEN
+2 ;check if rule already exists
SET RORIEN=$$SRLIEN^RORUTL02(NAME)
+3 IF RORIEN<0
SET DIC(0)=""
SET DIC="^ROR(798.2,"
SET X=NAME
DO FILE^DICN
SET RORIEN=$PIECE(Y,U,1)
+4 KILL DIC,X,Y
+5 if RORIEN<0
QUIT
+6 LOCK +^ROR(798.2,RORIEN):0
+7 if '$TEST
QUIT
+8 KILL DIE
SET DIE="^ROR(798.2,"
SET DA=RORIEN
SET DR=".09////1;1////"_EXPR_";2////"_FILE_";4////"_DESC_";7////30"
+9 DO ^DIE
+10 LOCK -^ROR(798.2,RORIEN)
+11 KILL DIE,DA,DR
+12 QUIT
+13 ;
+14 ;Save existing Common Templates in a ^XTMP global
SAVETMPL ;
+1 NEW RORLST,RORDATE,%H,RORIPRT,RORBUF,RORENTITY,RORPARAM,RORINSTANCE,RORINSTNAME
+2 ;Save existing common templates in a ^XTMP global
+3 SET %H=+$HOROLOG+180
DO YMD^%DTC
SET RORDATE=X
KILL X
+4 SET ^XTMP("RORP19",$JOB,0)=RORDATE_U_DT_U_"Backup of Common Templates in File 8989.5 by "_$GET(DUZ)
+5 SET RORENTITY="PKG.CLINICAL CASE REGISTRIES"
+6 SET RORPARAM="ROR REPORT PARAMS TEMPLATE"
+7 DO GETPLIST^RORRP038(.RORLST,"ROR REPORT PARAMS TEMPLATE","PKG")
+8 SET RORIPRT=0
+9 FOR
SET RORIPRT=$ORDER(RORLST(RORIPRT))
if RORIPRT'>0
QUIT
Begin DoDot:1
+10 SET RORINSTANCE=$PIECE(RORLST(RORIPRT),U,1)
+11 SET RORINSTNAME=RORINSTANCE_U_"ROR REPORT PARAMS TEMPLATE"
+12 DO GETPARM^RORRP038(.RORBUF,RORINSTNAME,"PKG")
+13 if $GET(RORBUF(0))<0
QUIT
+14 KILL RORBUF(0)
if $DATA(RORBUF)<10
QUIT
+15 ;save an existing common template
+16 SET ^XTMP("RORP19",$JOB,RORIPRT)=RORINSTANCE
+17 MERGE ^XTMP("RORP19",$JOB,RORIPRT)=RORBUF
+18 ;delete an existing common template
+19 DO DEL^XPAR(RORENTITY,RORPARAM,RORINSTANCE)
End DoDot:1
+20 QUIT
+21 ;
+22 ;Build Common Templates with ICD-9 and ICD-10 codes
UPDTMPL ;
+1 NEW I,J,RORTMPL,RORVALUE,RORTYPE,RORENTITY,RORPARAM,RORGROUP,RORCNT,RORICDCODES,RORICDCODE,RORICDIEN,RORICDDESC
+2 NEW RORVERSION,RORCSYS,ROREXTN
+3 SET RORENTITY="PKG.CLINICAL CASE REGISTRIES"
+4 SET RORPARAM="ROR REPORT PARAMS TEMPLATE"
+5 FOR ROREXTN="A","B"
Begin DoDot:1
+6 FOR I=1:1
SET RORTMPL=$PIECE($TEXT(@("TMPLCODE+"_I_"^RORP019"_ROREXTN)),";;",2)
if RORTMPL=""
QUIT
Begin DoDot:2
+7 ;1=XML Header, 2=ICD-9 codes, 3=ICD-10 codes, 9=XML Footer
SET RORTYPE=$PIECE(RORTMPL,"^",1)
+8 ;XML Header Info
IF RORTYPE="1"
Begin DoDot:3
+9 SET RORGROUP=$PIECE(RORTMPL,"^",2)
+10 SET RORINSTANCE="13::"_RORGROUP
+11 SET RORVALUE="CCR Predefined Report Template"
+12 SET RORCNT=0
+13 SET RORCNT=RORCNT+1
SET RORVALUE(RORCNT,0)="<?xml version="_"""1.0"""_" encoding="_"""UTF-8"""_"?>"
+14 SET RORCNT=RORCNT+1
SET RORVALUE(RORCNT,0)="<PARAMS>"
+15 SET RORCNT=RORCNT+1
SET RORVALUE(RORCNT,0)="<ICDLST>"
+16 SET RORCNT=RORCNT+1
SET RORVALUE(RORCNT,0)="<GROUP ID="""_RORGROUP_""">"
End DoDot:3
+17 ;XML Body with ICD-9/ICD-10 codes
IF (RORTYPE="2")!(RORTYPE="3")
Begin DoDot:3
+18 SET RORICDCODES=$PIECE(RORTMPL,"^",2)
+19 FOR J=1:1
SET RORICDCODE=$PIECE(RORICDCODES,",",J)
if RORICDCODE=""
QUIT
Begin DoDot:4
+20 SET RORCNT=RORCNT+1
+21 SET RORCSYS=$SELECT(RORTYPE=2:"1",1:"30")
+22 SET RORICDIEN=$$CODEABA^ICDEX(RORICDCODE,"",RORCSYS)
+23 if '(RORICDIEN>0)
QUIT
+24 SET RORVERSION=$SELECT(RORTYPE=2:"ICD-9",1:"ICD-10")
+25 SET RORICDDESC=$$XMLENC^RORUTL03($$VSTD^ICDEX(RORICDIEN))
+26 SET RORVALUE(RORCNT,0)="<ICD ID="""_RORICDCODE_""" VERSION="""_RORVERSION_""">"_RORICDDESC_"</ICD>"
End DoDot:4
End DoDot:3
+27 ;XML Footer Info
IF RORTYPE="9"
Begin DoDot:3
+28 SET RORCNT=RORCNT+1
SET RORVALUE(RORCNT,0)="</GROUP>"
+29 SET RORCNT=RORCNT+1
SET RORVALUE(RORCNT,0)="</ICDLST>"
+30 SET RORCNT=RORCNT+1
SET RORVALUE(RORCNT,0)="<PANELS>"
+31 SET RORCNT=RORCNT+1
SET RORVALUE(RORCNT,0)="<PANEL ID="_"""160"""_"/>"
+32 SET RORCNT=RORCNT+1
SET RORVALUE(RORCNT,0)="</PANELS>"
+33 SET RORCNT=RORCNT+1
SET RORVALUE(RORCNT,0)="</PARAMS>"
+34 DO ADD^XPAR(RORENTITY,RORPARAM,RORINSTANCE,.RORVALUE)
+35 KILL RORVALUE
End DoDot:3
End DoDot:2
End DoDot:1
+36 QUIT
+37 ;
