- 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 Feb 18, 2025@23:11:04 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