- 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 Jan 18, 2025@02:46:25 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