RORXU008 ;HCIOFO/SG - REPORT PARAMETERS (CONT.) ;6/21/06 2:08pm
;;1.5;CLINICAL CASE REGISTRIES;**1,19**;Feb 17, 2006;Build 43
;
Q
;
;***** PROCESSES THE LIST OF ICD CODES
;
; .RORTSK Task number and task parameters
;
; PARTAG Reference (IEN) to the parent tag
;
; .ROR8LST Reference to a local variable, which contains a
; closed root of an array. IEN's of ICD codes
; will be returned into this array.
;
; @ROR8LST@(IEN,Group#) = ""
;
; If this parameter is undefined or empty, then a
; temporary buffer is allocated by the $$ALLOC^RORTMP
; function and its root is returned via this parameter.
;
; If all ICD codes are requested (the "ALL" attribute
; of the "ICDLST" tag), then "*" is returned.
;
; [.GRPLST] Reference to a local variable that will contain
; the list of ICD code groups.
;
; GRPLST(
; "C",Group#) = GroupName
; "N",GroupName) = Group#
;
; Return Values:
; <0 Error code
; >0 IEN of the ICDLST element
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
;ROR*1.5*19 FEB 2012 J SCOTT Change entry point ICD9LST to ICDLST.
;******************************************************************************
;******************************************************************************
;
ICDLST(RORTSK,PARTAG,ROR8LST,GRPLST) ;
;
N ATTR,ICDALL,ICDOPTS,LTAG,RC,TMP
;
S ICDALL=+$$PARAM^RORTSK01("ICDLST","ALL")
S (LTAG,RC)=0
;
;=== Validate parameters
I 'ICDALL D K @ROR8LST
. S:$G(ROR8LST)="" ROR8LST=$$ALLOC^RORTMP()
E S ROR8LST="*"
;
;=== Process the drug options (if present)
M ICDOPTS=RORTSK("PARAMS","ICDLST","A")
I $D(ICDOPTS)>1 D Q:LTAG'>0 LTAG
. S ATTR=$S(ICDALL:"ALL",1:"")
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"ICDLST",ATTR,PARTAG)
. Q:LTAG'>0
. ;--- Output option attributes
. S ATTR="",RC=0
. F S ATTR=$O(ICDOPTS(ATTR)) Q:ATTR="" D Q:RC<0
. . S RC=$$ADDATTR^RORTSK11(RORTSK,LTAG,ATTR,"1")
. I RC<0 S LTAG=RC Q
. S ATTR=$$OPTXT^RORXU002(.ICDOPTS)
. D:ATTR'="" ADDATTR^RORTSK11(RORTSK,LTAG,"DESCR",ATTR)
;
;=== Process the list of ICD codes (if present)
I 'ICDALL D:$D(RORTSK("PARAMS","ICDLST","G"))>1
. N GRPNAME,GRPTAG,IG,NODE,RORICDIEN,RORICDCODE,RORXMLNODE,RORICDSYS
. I LTAG'>0 D Q:LTAG'>0
. . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"ICDLST",,PARTAG)
. ;--
. S NODE=$NA(RORTSK("PARAMS","ICDLST","G"))
. S GRPNAME="",RC=0
. F S GRPNAME=$O(@NODE@(GRPNAME)) Q:GRPNAME="" D Q:RC<0
. . S IG=$O(GRPLST("C",""),-1)+1
. . S GRPLST("C",IG)=GRPNAME,GRPLST("N",GRPNAME)=IG
. . S GRPTAG=$$ADDVAL^RORTSK11(RORTSK,"GROUP",,LTAG)
. . I GRPTAG'>0 S RC=GRPTAG Q
. . D ADDATTR^RORTSK11(RORTSK,GRPTAG,"NAME",GRPNAME)
. . S RORICDIEN=0
. . F S RORICDIEN=$O(@NODE@(GRPNAME,"C",RORICDIEN)) Q:RORICDIEN'>0 D
. . . S RORICDCODE=$P(@NODE@(GRPNAME,"C",RORICDIEN),U,1) Q:RORICDCODE=""
. . . S RORICDSYS=$P(@NODE@(GRPNAME,"C",RORICDIEN),U,2)
. . . S RORXMLNODE=$S(RORICDSYS=1:"ICD9",RORICDSYS=2:"ICD9",1:"ICD10")
. . . D ADDVAL^RORTSK11(RORTSK,RORXMLNODE,RORICDCODE,GRPTAG,,RORICDIEN)
. . . S @ROR8LST@(RORICDIEN,IG)=""
;
Q $S(RC<0:RC,1:LTAG)
;
;***** FUNCTION FOR THE PHARMACY SEARCH API
;
; .GRPLST Reference to a local variable that contains a list
; of group codes. It is used to determine if codes
; from all groups were found.
;
; ICDIEN IEN of the ICD code
;
; ROR8LST Closed root of the ICD code list generated by the
; $$ICDLST^RORXU008 function or "*" for all drugs.
;
; Return Values:
; 0 Ok
; 1 Skip the record
;
ICDGRCHK(GRPLST,ICDIEN,ROR8LST) ;
Q:ROR8LST="*" 0
Q:$D(@ROR8LST@(ICDIEN))<10 1
N GRP S GRP=""
F S GRP=$O(@ROR8LST@(ICDIEN,GRP)) Q:GRP="" K GRPLST(GRP)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORXU008 4376 printed Sep 23, 2025@19:21:10 Page 2
RORXU008 ;HCIOFO/SG - REPORT PARAMETERS (CONT.) ;6/21/06 2:08pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,19**;Feb 17, 2006;Build 43
+2 ;
+3 QUIT
+4 ;
+5 ;***** PROCESSES THE LIST OF ICD CODES
+6 ;
+7 ; .RORTSK Task number and task parameters
+8 ;
+9 ; PARTAG Reference (IEN) to the parent tag
+10 ;
+11 ; .ROR8LST Reference to a local variable, which contains a
+12 ; closed root of an array. IEN's of ICD codes
+13 ; will be returned into this array.
+14 ;
+15 ; @ROR8LST@(IEN,Group#) = ""
+16 ;
+17 ; If this parameter is undefined or empty, then a
+18 ; temporary buffer is allocated by the $$ALLOC^RORTMP
+19 ; function and its root is returned via this parameter.
+20 ;
+21 ; If all ICD codes are requested (the "ALL" attribute
+22 ; of the "ICDLST" tag), then "*" is returned.
+23 ;
+24 ; [.GRPLST] Reference to a local variable that will contain
+25 ; the list of ICD code groups.
+26 ;
+27 ; GRPLST(
+28 ; "C",Group#) = GroupName
+29 ; "N",GroupName) = Group#
+30 ;
+31 ; Return Values:
+32 ; <0 Error code
+33 ; >0 IEN of the ICDLST element
+34 ;
+35 ;******************************************************************************
+36 ;******************************************************************************
+37 ; --- ROUTINE MODIFICATION LOG ---
+38 ;
+39 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+40 ;----------- ---------- ----------- ----------------------------------------
+41 ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
+42 ;ROR*1.5*19 FEB 2012 J SCOTT Change entry point ICD9LST to ICDLST.
+43 ;******************************************************************************
+44 ;******************************************************************************
+45 ;
ICDLST(RORTSK,PARTAG,ROR8LST,GRPLST) ;
+1 ;
+2 NEW ATTR,ICDALL,ICDOPTS,LTAG,RC,TMP
+3 ;
+4 SET ICDALL=+$$PARAM^RORTSK01("ICDLST","ALL")
+5 SET (LTAG,RC)=0
+6 ;
+7 ;=== Validate parameters
+8 IF 'ICDALL
Begin DoDot:1
+9 if $GET(ROR8LST)=""
SET ROR8LST=$$ALLOC^RORTMP()
End DoDot:1
KILL @ROR8LST
+10 IF '$TEST
SET ROR8LST="*"
+11 ;
+12 ;=== Process the drug options (if present)
+13 MERGE ICDOPTS=RORTSK("PARAMS","ICDLST","A")
+14 IF $DATA(ICDOPTS)>1
Begin DoDot:1
+15 SET ATTR=$SELECT(ICDALL:"ALL",1:"")
+16 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"ICDLST",ATTR,PARTAG)
+17 if LTAG'>0
QUIT
+18 ;--- Output option attributes
+19 SET ATTR=""
SET RC=0
+20 FOR
SET ATTR=$ORDER(ICDOPTS(ATTR))
if ATTR=""
QUIT
Begin DoDot:2
+21 SET RC=$$ADDATTR^RORTSK11(RORTSK,LTAG,ATTR,"1")
End DoDot:2
if RC<0
QUIT
+22 IF RC<0
SET LTAG=RC
QUIT
+23 SET ATTR=$$OPTXT^RORXU002(.ICDOPTS)
+24 if ATTR'=""
DO ADDATTR^RORTSK11(RORTSK,LTAG,"DESCR",ATTR)
End DoDot:1
if LTAG'>0
QUIT LTAG
+25 ;
+26 ;=== Process the list of ICD codes (if present)
+27 IF 'ICDALL
if $DATA(RORTSK("PARAMS","ICDLST","G"))>1
Begin DoDot:1
+28 NEW GRPNAME,GRPTAG,IG,NODE,RORICDIEN,RORICDCODE,RORXMLNODE,RORICDSYS
+29 IF LTAG'>0
Begin DoDot:2
+30 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"ICDLST",,PARTAG)
End DoDot:2
if LTAG'>0
QUIT
+31 ;--
+32 SET NODE=$NAME(RORTSK("PARAMS","ICDLST","G"))
+33 SET GRPNAME=""
SET RC=0
+34 FOR
SET GRPNAME=$ORDER(@NODE@(GRPNAME))
if GRPNAME=""
QUIT
Begin DoDot:2
+35 SET IG=$ORDER(GRPLST("C",""),-1)+1
+36 SET GRPLST("C",IG)=GRPNAME
SET GRPLST("N",GRPNAME)=IG
+37 SET GRPTAG=$$ADDVAL^RORTSK11(RORTSK,"GROUP",,LTAG)
+38 IF GRPTAG'>0
SET RC=GRPTAG
QUIT
+39 DO ADDATTR^RORTSK11(RORTSK,GRPTAG,"NAME",GRPNAME)
+40 SET RORICDIEN=0
+41 FOR
SET RORICDIEN=$ORDER(@NODE@(GRPNAME,"C",RORICDIEN))
if RORICDIEN'>0
QUIT
Begin DoDot:3
+42 SET RORICDCODE=$PIECE(@NODE@(GRPNAME,"C",RORICDIEN),U,1)
if RORICDCODE=""
QUIT
+43 SET RORICDSYS=$PIECE(@NODE@(GRPNAME,"C",RORICDIEN),U,2)
+44 SET RORXMLNODE=$SELECT(RORICDSYS=1:"ICD9",RORICDSYS=2:"ICD9",1:"ICD10")
+45 DO ADDVAL^RORTSK11(RORTSK,RORXMLNODE,RORICDCODE,GRPTAG,,RORICDIEN)
+46 SET @ROR8LST@(RORICDIEN,IG)=""
End DoDot:3
End DoDot:2
if RC<0
QUIT
End DoDot:1
+47 ;
+48 QUIT $SELECT(RC<0:RC,1:LTAG)
+49 ;
+50 ;***** FUNCTION FOR THE PHARMACY SEARCH API
+51 ;
+52 ; .GRPLST Reference to a local variable that contains a list
+53 ; of group codes. It is used to determine if codes
+54 ; from all groups were found.
+55 ;
+56 ; ICDIEN IEN of the ICD code
+57 ;
+58 ; ROR8LST Closed root of the ICD code list generated by the
+59 ; $$ICDLST^RORXU008 function or "*" for all drugs.
+60 ;
+61 ; Return Values:
+62 ; 0 Ok
+63 ; 1 Skip the record
+64 ;
ICDGRCHK(GRPLST,ICDIEN,ROR8LST) ;
+1 if ROR8LST="*"
QUIT 0
+2 if $DATA(@ROR8LST@(ICDIEN))<10
QUIT 1
+3 NEW GRP
SET GRP=""
+4 FOR
SET GRP=$ORDER(@ROR8LST@(ICDIEN,GRP))
if GRP=""
QUIT
KILL GRPLST(GRP)
+5 QUIT 0
