RORX014A ;HOIFO/BH,SG,VAC - REGISTRY MEDS REPORT (QUERY & SORT) ;4/7/09 2:09pm
;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,39**;Feb 17, 2006;Build 4
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
; 'include' or 'exclude'.
;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
; clinics, or divisions for the report.
;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
; additional identifier option selected
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
; identifiers.
;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
;******************************************************************************
;******************************************************************************
Q
;
;***** ADDS THE DRUG COMBINATION TO THE REPORT
;
; RXLST List of drug IEN's separated by commas
; PATIEN Patient IEN in file #2 (DFN)
;
ADD(RXLST,PATIEN) ;
N RXCIEN,RXCNDX,TMP,VA,VADM,VAERR
S RXCNDX=$E(RXLST,1,100)
;--- Search for the combination
S RXCIEN=""
F D Q:RXCIEN="" Q:^TMP("RORX014",$J,"RXC",RXCIEN,1)=RXLST
. S RXCIEN=$O(^TMP("RORX014",$J,"RXC","B",RXCNDX,RXCIEN))
;--- Add new combination
D:RXCIEN'>0
. S RXCIEN=$O(^TMP("RORX014",$J,"RXC"," "),-1)+1
. S ^TMP("RORX014",$J,"RXC",RXCIEN,1)=RXLST
. S ^TMP("RORX014",$J,"RXC","B",RXCNDX,RXCIEN)=""
;--- Add new patient
S ^("P")=$G(^TMP("RORX014",$J,"RXC",RXCIEN,"P"))+1 ;naked reference: ^TMP("RORX014",$J,"RXC",RXCIEN,"P")
D VADEM^RORUTL05(PATIEN,1)
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") D
. S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
S TMP=VA("BID")_U_VADM(1)_U_$$DATE^RORXU002(VADM(6)\1)_U_$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
S TMP=TMP_U_$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")_U_$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")_U_AGE
S ^TMP("RORX014",$J,"RXC",RXCIEN,"P",PATIEN)=TMP
Q
;
;***** QUERIES THE REGISTRY
;
; FLAGS Flags for the $$SKIP^RORXU005
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
QUERY(FLAGS) ;
N RORPTN ; Number of patients in the registry
N RORXDST ; Descriptor for pharmacy search API
;
N CNT,DRGIEN,ECNT,NAME,PATIEN,RC,RORIEN,RXFLAGS,STR,TMP,XREFNODE
N RCC,FLAG
N RORCDLIST ; Flag to indicate whether a clinic or division list exists
N RORCDSTDT ; Start date for clinic/division utilization search
N RORCDENDT ; End date for clinic/division utilization search
;
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
S (CNT,ECNT,RC)=0
;
;--- Prepare parameters for the pharmacy search API
S RORXDST=$NA(RORXDST("RORX014"))
S RORXDST("RORCB")="$$RXSCB^RORX014A"
S RORXDST("GENERIC")=$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
S RXFLAGS="E"
S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") RXFLAGS=RXFLAGS_"IV"
S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") RXFLAGS=RXFLAGS_"O"
Q:RXFLAGS="E" 0
;
;=== Set up Clinic/Division list parameters
S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
;
;--- Browse through the registry records
S RORIEN=0
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
F S RORIEN=$O(@XREFNODE@(RORIEN)) Q:RORIEN'>0 D Q:RC<0
. S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. S CNT=CNT+1
. ;--- Get patient DFN
. S PATIEN=$$PTIEN^RORUTL01(RORIEN) Q:PATIEN'>0
. ;check for patient list and quit if not on list
. I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PATIEN)) Q
. ;--- Check if the patient should be skipped
. Q:$$SKIP^RORXU005(RORIEN,FLAGS,RORSDT,ROREDT)
. ;--- Check the patient against the ICD Filter
. S RCC=0
. I FLAG'="ALL" D
. . S RCC=$$ICD^RORXU010(PATIEN)
. I (FLAG="INCLUDE")&(RCC=0) Q
. I (FLAG="EXCLUDE")&(RCC=1) Q
. ;--- End of ICD check
. ;
. ;--- Check for Clinic or Division list and quit if not in list
. I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT) Q
. ;
. ;--- Search for pharmacy data
. S TMP=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,RXFLAGS,RORSDT,ROREDT1)
. I TMP'>0 S:TMP<0 ECNT=ECNT+1 Q:$D(@RORXDST)<10
. ;
. S (NAME,STR)=""
. F S NAME=$O(@RORXDST@(NAME)) Q:NAME="" D
. . S DRGIEN=0
. . F S DRGIEN=$O(@RORXDST@(NAME,DRGIEN)) Q:DRGIEN'>0 D
. . . S ^TMP("RORX014",$J,"DRG",DRGIEN)=NAME
. . . S STR=STR_","_DRGIEN
. K @RORXDST
. ;
. D ADD($P(STR,",",2,999),PATIEN)
;
;---
Q $S(RC<0:RC,1:ECNT)
;
;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
RXSCB(RORDST,ORDER,ORDFLG,DRUG,DATE) ;
N IEN,NAME
I ROR8DST("GENERIC") D
. S IEN=+ROR8DST("RORXGEN"),NAME=$P(ROR8DST("RORXGEN"),U,2)
E S IEN=+DRUG,NAME=$P(DRUG,U,2)
Q:(IEN'>0)!(NAME="") 1
S @RORDST@(NAME,IEN)=""
Q 0
;
;***** SORTS THE RESULTS AND COMPILES THE TOTALS
;
; NRXC Number of drug combinations
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
SORT(NRXC) ;
N IEN,TMP
S (IEN,NRXC)=0
F S IEN=$O(^TMP("RORX014",$J,"RXC",IEN)) Q:IEN'>0 D
. S TMP=^TMP("RORX014",$J,"RXC",IEN,"P")
. S ^TMP("RORX014",$J,"RXC","P",TMP,IEN)="",NRXC=NRXC+1
Q 0
;
;***** STORES THE REPORT DATA
;
; REPORT IEN of the REPORT element
; NRXC Number of drug combinations
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
STORE(REPORT,NRXC) ;
N BUF,CNT,DRG,ITEM,NODE,PATIEN,RORI,RXCIEN,RXCNT,RXCOMB,SECTION,TABLE,VA,VADM,VAERR,AGETYPE,AGE
S NODE=$NA(^TMP("RORX014",$J))
S SECTION=$$ADDVAL^RORTSK11(RORTSK,"RXCOMBLST",,REPORT)
Q:SECTION<0 SECTION
D ADDATTR^RORTSK11(RORTSK,SECTION,"TABLE","RXCOMBLST")
;---
Q:NRXC'>0 0
;---
S RXCNT="",CNT=0,AGE=""
F S RXCNT=$O(@NODE@("RXC","P",RXCNT),-1) Q:RXCNT="" D
. S RC=$$LOOP^RORTSK01(CNT/NRXC),CNT=CNT+1 Q:RC<0
. S RXCIEN=""
. F S RXCIEN=$O(@NODE@("RXC","P",RXCNT,RXCIEN),-1) Q:RXCIEN="" D
. . S RXCOMB=$$ADDVAL^RORTSK11(RORTSK,"RXCOMB",,SECTION)
. . ;--- List of drugs
. . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,RXCOMB)
. . S BUF=@NODE@("RXC",RXCIEN,1)
. . F RORI=1:1 S DRG=$P(BUF,",",RORI) Q:DRG="" D
. . . S DRG=$P(^TMP("RORX014",$J,"DRG",DRG),U)
. . . D ADDVAL^RORTSK11(RORTSK,"NAME",DRG,TABLE,1)
. . ;--- Number of unique patients
. . D ADDVAL^RORTSK11(RORTSK,"NP",RXCNT,RXCOMB,3)
. . ;--- List of patients
. . Q:'$$PARAM^RORTSK01("OPTIONS","COMPLETE")
. . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,RXCOMB)
. . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
. . S PATIEN=""
. . F S PATIEN=$O(@NODE@("RXC",RXCIEN,"P",PATIEN)) Q:PATIEN="" D
. . . S BUF=@NODE@("RXC",RXCIEN,"P",PATIEN)
. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE,,PATIEN)
. . . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(BUF,U,2),ITEM,1)
. . . S $P(BUF,U)="0000" D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
. . . ;
. . . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
. . . . D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(BUF,U,7),ITEM,1)
. . . ;
. . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,3),ITEM,1)
. . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",$P(BUF,U,4),ITEM,1)
. . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",$P(BUF,U,5),ITEM,1)
. . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",$P(BUF,U,6),ITEM,1)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX014A 8293 printed Sep 23, 2025@19:20:41 Page 2
RORX014A ;HOIFO/BH,SG,VAC - REGISTRY MEDS REPORT (QUERY & SORT) ;4/7/09 2:09pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,39**;Feb 17, 2006;Build 4
+2 ;
+3 ;******************************************************************************
+4 ;******************************************************************************
+5 ; --- ROUTINE MODIFICATION LOG ---
+6 ;
+7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+8 ;----------- ---------- ----------- ----------------------------------------
+9 ;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
+10 ; 'include' or 'exclude'.
+11 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
+12 ; clinics, or divisions for the report.
+13 ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
+14 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
+15 ; additional identifier option selected
+16 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
+17 ; identifiers.
+18 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+19 ;******************************************************************************
+20 ;******************************************************************************
+21 QUIT
+22 ;
+23 ;***** ADDS THE DRUG COMBINATION TO THE REPORT
+24 ;
+25 ; RXLST List of drug IEN's separated by commas
+26 ; PATIEN Patient IEN in file #2 (DFN)
+27 ;
ADD(RXLST,PATIEN) ;
+1 NEW RXCIEN,RXCNDX,TMP,VA,VADM,VAERR
+2 SET RXCNDX=$EXTRACT(RXLST,1,100)
+3 ;--- Search for the combination
+4 SET RXCIEN=""
+5 FOR
Begin DoDot:1
+6 SET RXCIEN=$ORDER(^TMP("RORX014",$JOB,"RXC","B",RXCNDX,RXCIEN))
End DoDot:1
if RXCIEN=""
QUIT
if ^TMP("RORX014",$JOB,"RXC",RXCIEN,1)=RXLST
QUIT
+7 ;--- Add new combination
+8 if RXCIEN'>0
Begin DoDot:1
+9 SET RXCIEN=$ORDER(^TMP("RORX014",$JOB,"RXC"," "),-1)+1
+10 SET ^TMP("RORX014",$JOB,"RXC",RXCIEN,1)=RXLST
+11 SET ^TMP("RORX014",$JOB,"RXC","B",RXCNDX,RXCIEN)=""
End DoDot:1
+12 ;--- Add new patient
+13 ;naked reference: ^TMP("RORX014",$J,"RXC",RXCIEN,"P")
SET ^("P")=$GET(^TMP("RORX014",$JOB,"RXC",RXCIEN,"P"))+1
+14 DO VADEM^RORUTL05(PATIEN,1)
+15 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
Begin DoDot:1
+16 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
End DoDot:1
+17 SET TMP=VA("BID")_U_VADM(1)_U_$$DATE^RORXU002(VADM(6)\1)_U_$SELECT($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
+18 SET TMP=TMP_U_$SELECT($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")_U_$SELECT($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")_U_AGE
+19 SET ^TMP("RORX014",$JOB,"RXC",RXCIEN,"P",PATIEN)=TMP
+20 QUIT
+21 ;
+22 ;***** QUERIES THE REGISTRY
+23 ;
+24 ; FLAGS Flags for the $$SKIP^RORXU005
+25 ;
+26 ; Return Values:
+27 ; <0 Error code
+28 ; 0 Ok
+29 ; >0 Number of non-fatal errors
+30 ;
QUERY(FLAGS) ;
+1 ; Number of patients in the registry
NEW RORPTN
+2 ; Descriptor for pharmacy search API
NEW RORXDST
+3 ;
+4 NEW CNT,DRGIEN,ECNT,NAME,PATIEN,RC,RORIEN,RXFLAGS,STR,TMP,XREFNODE
+5 NEW RCC,FLAG
+6 ; Flag to indicate whether a clinic or division list exists
NEW RORCDLIST
+7 ; Start date for clinic/division utilization search
NEW RORCDSTDT
+8 ; End date for clinic/division utilization search
NEW RORCDENDT
+9 ;
+10 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
+11 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+12 SET (CNT,ECNT,RC)=0
+13 ;
+14 ;--- Prepare parameters for the pharmacy search API
+15 SET RORXDST=$NAME(RORXDST("RORX014"))
+16 SET RORXDST("RORCB")="$$RXSCB^RORX014A"
+17 SET RORXDST("GENERIC")=$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
+18 SET RXFLAGS="E"
+19 if $$PARAM^RORTSK01("PATIENTS","INPATIENT")
SET RXFLAGS=RXFLAGS_"IV"
+20 if $$PARAM^RORTSK01("PATIENTS","OUTPATIENT")
SET RXFLAGS=RXFLAGS_"O"
+21 if RXFLAGS="E"
QUIT 0
+22 ;
+23 ;=== Set up Clinic/Division list parameters
+24 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
+25 ;
+26 ;--- Browse through the registry records
+27 SET RORIEN=0
+28 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+29 FOR
SET RORIEN=$ORDER(@XREFNODE@(RORIEN))
if RORIEN'>0
QUIT
Begin DoDot:1
+30 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+31 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+32 SET CNT=CNT+1
+33 ;--- Get patient DFN
+34 SET PATIEN=$$PTIEN^RORUTL01(RORIEN)
if PATIEN'>0
QUIT
+35 ;check for patient list and quit if not on list
+36 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",PATIEN))
QUIT
+37 ;--- Check if the patient should be skipped
+38 if $$SKIP^RORXU005(RORIEN,FLAGS,RORSDT,ROREDT)
QUIT
+39 ;--- Check the patient against the ICD Filter
+40 SET RCC=0
+41 IF FLAG'="ALL"
Begin DoDot:2
+42 SET RCC=$$ICD^RORXU010(PATIEN)
End DoDot:2
+43 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+44 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+45 ;--- End of ICD check
+46 ;
+47 ;--- Check for Clinic or Division list and quit if not in list
+48 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT)
QUIT
+49 ;
+50 ;--- Search for pharmacy data
+51 SET TMP=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,RXFLAGS,RORSDT,ROREDT1)
+52 IF TMP'>0
if TMP<0
SET ECNT=ECNT+1
if $DATA(@RORXDST)<10
QUIT
+53 ;
+54 SET (NAME,STR)=""
+55 FOR
SET NAME=$ORDER(@RORXDST@(NAME))
if NAME=""
QUIT
Begin DoDot:2
+56 SET DRGIEN=0
+57 FOR
SET DRGIEN=$ORDER(@RORXDST@(NAME,DRGIEN))
if DRGIEN'>0
QUIT
Begin DoDot:3
+58 SET ^TMP("RORX014",$JOB,"DRG",DRGIEN)=NAME
+59 SET STR=STR_","_DRGIEN
End DoDot:3
End DoDot:2
+60 KILL @RORXDST
+61 ;
+62 DO ADD($PIECE(STR,",",2,999),PATIEN)
End DoDot:1
if RC<0
QUIT
+63 ;
+64 ;---
+65 QUIT $SELECT(RC<0:RC,1:ECNT)
+66 ;
+67 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
RXSCB(RORDST,ORDER,ORDFLG,DRUG,DATE) ;
+1 NEW IEN,NAME
+2 IF ROR8DST("GENERIC")
Begin DoDot:1
+3 SET IEN=+ROR8DST("RORXGEN")
SET NAME=$PIECE(ROR8DST("RORXGEN"),U,2)
End DoDot:1
+4 IF '$TEST
SET IEN=+DRUG
SET NAME=$PIECE(DRUG,U,2)
+5 if (IEN'>0)!(NAME="")
QUIT 1
+6 SET @RORDST@(NAME,IEN)=""
+7 QUIT 0
+8 ;
+9 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
+10 ;
+11 ; NRXC Number of drug combinations
+12 ;
+13 ; Return Values:
+14 ; <0 Error code
+15 ; 0 Ok
+16 ; >0 Number of non-fatal errors
+17 ;
SORT(NRXC) ;
+1 NEW IEN,TMP
+2 SET (IEN,NRXC)=0
+3 FOR
SET IEN=$ORDER(^TMP("RORX014",$JOB,"RXC",IEN))
if IEN'>0
QUIT
Begin DoDot:1
+4 SET TMP=^TMP("RORX014",$JOB,"RXC",IEN,"P")
+5 SET ^TMP("RORX014",$JOB,"RXC","P",TMP,IEN)=""
SET NRXC=NRXC+1
End DoDot:1
+6 QUIT 0
+7 ;
+8 ;***** STORES THE REPORT DATA
+9 ;
+10 ; REPORT IEN of the REPORT element
+11 ; NRXC Number of drug combinations
+12 ;
+13 ; Return Values:
+14 ; <0 Error code
+15 ; 0 Ok
+16 ; >0 Number of non-fatal errors
+17 ;
STORE(REPORT,NRXC) ;
+1 NEW BUF,CNT,DRG,ITEM,NODE,PATIEN,RORI,RXCIEN,RXCNT,RXCOMB,SECTION,TABLE,VA,VADM,VAERR,AGETYPE,AGE
+2 SET NODE=$NAME(^TMP("RORX014",$JOB))
+3 SET SECTION=$$ADDVAL^RORTSK11(RORTSK,"RXCOMBLST",,REPORT)
+4 if SECTION<0
QUIT SECTION
+5 DO ADDATTR^RORTSK11(RORTSK,SECTION,"TABLE","RXCOMBLST")
+6 ;---
+7 if NRXC'>0
QUIT 0
+8 ;---
+9 SET RXCNT=""
SET CNT=0
SET AGE=""
+10 FOR
SET RXCNT=$ORDER(@NODE@("RXC","P",RXCNT),-1)
if RXCNT=""
QUIT
Begin DoDot:1
+11 SET RC=$$LOOP^RORTSK01(CNT/NRXC)
SET CNT=CNT+1
if RC<0
QUIT
+12 SET RXCIEN=""
+13 FOR
SET RXCIEN=$ORDER(@NODE@("RXC","P",RXCNT,RXCIEN),-1)
if RXCIEN=""
QUIT
Begin DoDot:2
+14 SET RXCOMB=$$ADDVAL^RORTSK11(RORTSK,"RXCOMB",,SECTION)
+15 ;--- List of drugs
+16 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,RXCOMB)
+17 SET BUF=@NODE@("RXC",RXCIEN,1)
+18 FOR RORI=1:1
SET DRG=$PIECE(BUF,",",RORI)
if DRG=""
QUIT
Begin DoDot:3
+19 SET DRG=$PIECE(^TMP("RORX014",$JOB,"DRG",DRG),U)
+20 DO ADDVAL^RORTSK11(RORTSK,"NAME",DRG,TABLE,1)
End DoDot:3
+21 ;--- Number of unique patients
+22 DO ADDVAL^RORTSK11(RORTSK,"NP",RXCNT,RXCOMB,3)
+23 ;--- List of patients
+24 if '$$PARAM^RORTSK01("OPTIONS","COMPLETE")
QUIT
+25 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,RXCOMB)
+26 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
+27 SET PATIEN=""
+28 FOR
SET PATIEN=$ORDER(@NODE@("RXC",RXCIEN,"P",PATIEN))
if PATIEN=""
QUIT
Begin DoDot:3
+29 SET BUF=@NODE@("RXC",RXCIEN,"P",PATIEN)
+30 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE,,PATIEN)
+31 DO ADDVAL^RORTSK11(RORTSK,"NAME",$PIECE(BUF,U,2),ITEM,1)
+32 SET $PIECE(BUF,U)="0000"
DO ADDVAL^RORTSK11(RORTSK,"LAST4",$PIECE(BUF,U),ITEM,2)
+33 ;
+34 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
IF AGETYPE'="ALL"
Begin DoDot:4
+35 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,$PIECE(BUF,U,7),ITEM,1)
End DoDot:4
+36 ;
+37 DO ADDVAL^RORTSK11(RORTSK,"DOD",$PIECE(BUF,U,3),ITEM,1)
+38 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",$PIECE(BUF,U,4),ITEM,1)
+39 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",$PIECE(BUF,U,5),ITEM,1)
+40 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",$PIECE(BUF,U,6),ITEM,1)
End DoDot:3
End DoDot:2
End DoDot:1
+41 QUIT 0
