235 lines
7.5 KiB
Mathematica
235 lines
7.5 KiB
Mathematica
RORX009A ;HCIOFO/SG - PRESCRIPTION UTILIZ. (QUERY & SORT) ; 10/12/05 11:49am
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
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 ROREDT1 ; Day after the end date
|
|
N RORPTN ; Number of patients in the registry
|
|
;
|
|
N CNT,ECNT,IEN,IENS,PATIEN,RC,RORXDST,RXFLAGS,TMP,XREFNODE
|
|
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
|
|
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
|
|
S ROREDT1=$$FMADD^XLFDT(ROREDT,1)
|
|
S (CNT,ECNT,RC)=0
|
|
;
|
|
;--- Prepare parameters for the pharmacy search API
|
|
S RORXDST=$NA(^TMP("RORX009",$J))
|
|
S RORXDST("RORCB")="$$RXSCB^RORX009A"
|
|
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
|
|
;
|
|
;--- Browse through the registry records
|
|
S IEN=0
|
|
F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
|
|
. S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
|
|
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
|
|
. S IENS=IEN_",",CNT=CNT+1
|
|
. ;--- Check if the patient should be skipped
|
|
. Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
|
|
. ;
|
|
. ;--- Get the patient IEN (DFN)
|
|
. S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
|
|
. ;
|
|
. ;--- Search the pharmacy data
|
|
. M RORXDST("RORXGRP")=RORXGRP("C")
|
|
. S TMP=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,RXFLAGS,RORSDT,ROREDT1)
|
|
. I TMP<0 S ECNT=ECNT+1 Q
|
|
. ;--- No medications from some groups
|
|
. Q:$D(RORXDST("RORXGRP"))>1
|
|
. ;--- Skip the patient if no data has been found
|
|
. I '$D(@RORXDST@("IP",PATIEN)),'$D(@RORXDST@("OP",PATIEN)) Q
|
|
. ;
|
|
. ;--- Calculate intermediate totals
|
|
. S RC=$$TOTALS(PATIEN)
|
|
. I RC S ECNT=ECNT+1 Q:RC<0
|
|
;---
|
|
Q $S(RC<0:RC,1:ECNT)
|
|
;
|
|
;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
|
|
RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
|
|
N DRUGIEN,DRUGNAME,IRP,RPS,RXCNT,SUBS,TMP
|
|
I ROR8DST("GENERIC") D
|
|
. S DRUGIEN=+ROR8DST("RORXGEN"),DRUGNAME=$P(ROR8DST("RORXGEN"),U,2)
|
|
E S DRUGIEN=+DRUG,DRUGNAME=$P(DRUG,U,2)
|
|
Q:(DRUGIEN'>0)!(DRUGNAME="") 1
|
|
;=== Check the drug groups
|
|
S TMP=$$RXGRPCHK^RORXU007(.ROR8DST,+DRUG,RORXL)
|
|
Q:TMP TMP
|
|
;=== Process the order
|
|
S SUBS=$S(ORDFLG["I":"IP",ORDFLG["O":"OP",1:"") Q:SUBS="" 1
|
|
S RXCNT=0
|
|
;--- Count the original order, refills and partials
|
|
I ORDFLG["I" S RXCNT=RXCNT+1 ; Inpatient
|
|
E D ; Outpatient
|
|
. S TMP=+$P($G(^TMP("PS",$J,"RXN",0)),U,6) ; Original Fill Date
|
|
. S:(TMP'<ROR8DST("RORSDT"))&(TMP<ROR8DST("ROREDT")) RXCNT=RXCNT+1
|
|
F RPS="PAR","REF" S IRP=0 D
|
|
. F S IRP=$O(^TMP("PS",$J,RPS,IRP)) Q:IRP'>0 S RXCNT=RXCNT+1
|
|
;--- Update the counters
|
|
D:RXCNT>0
|
|
. S TMP=$G(@ROR8DST@(SUBS,+ROR8DST("RORDFN"),"D",DRUGIEN))
|
|
. S @ROR8DST@(SUBS,+ROR8DST("RORDFN"),"D",DRUGIEN)=TMP+RXCNT
|
|
. S TMP=SUBS_"D"
|
|
. S:'$D(@ROR8DST@(TMP,DRUGIEN)) @ROR8DST@(TMP,DRUGIEN)=DRUGNAME
|
|
Q 0
|
|
;
|
|
;***** SORTS THE RESULTS AND COMPILES THE TOTALS
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
SORT() ;
|
|
N ECNT,NODE,RC
|
|
S (ECNT,RC)=0
|
|
S NODE=$NA(^TMP("RORX009",$J))
|
|
Q:$D(@NODE)<10 0
|
|
;---
|
|
S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
|
|
D SORTRX(NODE,"IPD")
|
|
;---
|
|
S RC=$$LOOP^RORTSK01(.33) Q:RC<0 RC
|
|
D SORTRX(NODE,"OPD")
|
|
;---
|
|
S RC=$$LOOP^RORTSK01(.66) Q:RC<0 RC
|
|
S RC=$$SUMRX(NODE)
|
|
;---
|
|
Q $S(RC<0:RC,1:ECNT)
|
|
;
|
|
;***** SORTS THE DRUG LIST
|
|
;
|
|
; NODE Closed root of the category section
|
|
; in the temporary global
|
|
;
|
|
; SUBS Drug list subscript ("IPD" or "OPD")
|
|
;
|
|
SORTRX(NODE,SUBS) ;
|
|
N IEN,NAME,NDRUGS,SUM,TMP
|
|
S IEN=0,NDRUGS=0
|
|
F S IEN=$O(@NODE@(SUBS,IEN)) Q:IEN'>0 D
|
|
. S NAME=@NODE@(SUBS,IEN),NDRUGS=NDRUGS+1
|
|
. S TMP=+$G(@NODE@(SUBS,IEN,"D"))
|
|
. S @NODE@(SUBS,"B",TMP,NAME,IEN)=""
|
|
;--- Numbers of different drugs
|
|
S @NODE@(SUBS)=NDRUGS
|
|
Q
|
|
;
|
|
;***** COMBINES THE INPATIENT AND OUTPATIENT DATA
|
|
;
|
|
; NODE Closed root of the category section
|
|
; in the temporary global
|
|
;
|
|
SUMRX(NODE) ;
|
|
N COUNT,I,MAXUTNUM,NDRX,NRX,RC,RXIEN,SUMNRX,TMP
|
|
Q:($D(@NODE@("IPRX"))<10)!($D(@NODE@("OPRX"))<10) 0
|
|
S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
|
|
Q:MAXUTNUM'>0 0
|
|
;
|
|
;=== Outpatient data
|
|
S NRX="",(COUNT,RC)=0
|
|
F S NRX=$O(@NODE@("OPRX",NRX),-1) Q:NRX="" D Q:RC
|
|
. S RC=$$LOOP^RORTSK01() Q:RC<0
|
|
. S @NODE@("SUMRX",NRX)=$G(@NODE@("OPRX",NRX))
|
|
. S NAME=""
|
|
. F S NAME=$O(@NODE@("OPRX",NRX,NAME)) Q:NAME="" D Q:RC
|
|
. . S DFN=""
|
|
. . F S DFN=$O(@NODE@("OPRX",NRX,NAME,DFN)) Q:DFN="" D Q:RC
|
|
. . . ;--- Include only the patients with highest utilization
|
|
. . . S COUNT=COUNT+1 I COUNT>MAXUTNUM S RC=1 Q
|
|
. . . ;--- Calculate the totals
|
|
. . . S (NDRX,SUMNRX)=0
|
|
. . . F I="IP","OP" S TMP=$G(@NODE@(I,DFN)) D
|
|
. . . . S NDRX=NDRX+$P(TMP,U,5),SUMNRX=SUMNRX+$P(TMP,U,4)
|
|
. . . S @NODE@("SUMRX",SUMNRX,NAME,DFN,"OP")=""
|
|
. . . S @NODE@("SUMRX",SUMNRX)=$G(@NODE@("SUMRX",SUMNRX))+1
|
|
. . . ;--- Adjust the total number of different drugs
|
|
. . . ;--- (some drugs could be both inpatient and outpatient)
|
|
. . . S RXIEN=0
|
|
. . . F S RXIEN=$O(@NODE@("OP",DFN,"D",RXIEN)) Q:RXIEN'>0 D
|
|
. . . . S:$D(@NODE@("IP",DFN,"D",RXIEN)) NDRX=NDRX-1
|
|
. . . ;--- Store the number of different drugs
|
|
. . . S @NODE@("SUMRX",SUMNRX,NAME,DFN)=NDRX
|
|
;
|
|
;=== Inpatient data
|
|
S NRX="",(COUNT,RC)=0
|
|
F S NRX=$O(@NODE@("IPRX",NRX),-1) Q:NRX="" D Q:RC
|
|
. S RC=$$LOOP^RORTSK01() Q:RC<0
|
|
. S NAME=""
|
|
. F S NAME=$O(@NODE@("IPRX",NRX,NAME)) Q:NAME="" D Q:RC
|
|
. . S DFN=""
|
|
. . F S DFN=$O(@NODE@("IPRX",NRX,NAME,DFN)) Q:DFN="" D Q:RC
|
|
. . . ;--- Include only the patients with highest utilization
|
|
. . . S COUNT=COUNT+1 I COUNT>MAXUTNUM S RC=1 Q
|
|
. . . ;--- Calculate the totals
|
|
. . . S (NDRX,SUMNRX)=0
|
|
. . . F I="IP","OP" S TMP=$G(@NODE@(I,DFN)) D
|
|
. . . . S NDRX=NDRX+$P(TMP,U,5),SUMNRX=SUMNRX+$P(TMP,U,4)
|
|
. . . S @NODE@("SUMRX",SUMNRX,NAME,DFN,"IP")=""
|
|
. . . ;--- Quit if the patient has been processed already
|
|
. . . Q:$D(@NODE@("SUMRX",SUMNRX,NAME,DFN,"OP"))
|
|
. . . S @NODE@("SUMRX",SUMNRX)=$G(@NODE@("SUMRX",SUMNRX))+1
|
|
. . . ;--- Adjust the total number of different drugs
|
|
. . . ;--- (some drugs could be both inpatient and outpatient)
|
|
. . . S RXIEN=0
|
|
. . . F S RXIEN=$O(@NODE@("IP",DFN,"D",RXIEN)) Q:RXIEN'>0 D
|
|
. . . . S:$D(@NODE@("OP",DFN,"D",RXIEN)) NDRX=NDRX-1
|
|
. . . ;--- Store the number of different drugs
|
|
. . . S @NODE@("SUMRX",SUMNRX,NAME,DFN)=NDRX
|
|
;===
|
|
Q $S(RC<0:RC,1:0)
|
|
;
|
|
;***** CALCULATES THE INTERMEDIATE TOTALS
|
|
;
|
|
; PATIEN Patient IEN (DFN)
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
TOTALS(PATIEN) ;
|
|
N DOD,IEN,LAST4,NDRUGS,NODE,NRX,PTNAME,PTNRX,RXS,SUBS,TMP,VA,VADM,VAERR
|
|
S NODE=$NA(^TMP("RORX009",$J))
|
|
;--- Get the patient's data
|
|
D VADEM^RORUTL05(PATIEN,1)
|
|
S PTNAME=VADM(1),LAST4=VA("BID"),DOD=$$DATE^RORXU002(VADM(6)\1)
|
|
;---
|
|
F SUBS="IP","OP" D:$D(@NODE@(SUBS,PATIEN))>1
|
|
. S RXS=SUBS_"D"
|
|
. S IEN=0,(NDRUGS,PTNRX)=0
|
|
. F S IEN=$O(@NODE@(SUBS,PATIEN,"D",IEN)) Q:IEN'>0 D
|
|
. . S NRX=@NODE@(SUBS,PATIEN,"D",IEN)
|
|
. . S NDRUGS=NDRUGS+1,PTNRX=PTNRX+NRX
|
|
. . ;---
|
|
. . S @NODE@(RXS,IEN,"D")=$G(@NODE@(RXS,IEN,"D"))+NRX
|
|
. . S @NODE@(RXS,IEN,"P")=$G(@NODE@(RXS,IEN,"P"))+1
|
|
. . ;---
|
|
. . S TMP=$G(@NODE@(RXS,IEN,"M"))
|
|
. . D:NRX'<TMP
|
|
. . . I NRX>TMP S @NODE@(RXS,IEN,"M")=NRX_U_1 Q
|
|
. . . S $P(@NODE@(RXS,IEN,"M"),U,2)=$P(TMP,U,2)+1
|
|
. ;---
|
|
. S @NODE@(SUBS)=$G(@NODE@(SUBS))+1
|
|
. S @NODE@(SUBS,PATIEN)=LAST4_U_PTNAME_U_DOD_U_PTNRX_U_NDRUGS
|
|
. ;---
|
|
. S RXS=SUBS_"RX"
|
|
. S @NODE@(RXS)=$G(@NODE@(RXS))+PTNRX
|
|
. S @NODE@(RXS,PTNRX)=$G(@NODE@(RXS,PTNRX))+1
|
|
. S @NODE@(RXS,PTNRX,PTNAME,PATIEN)=""
|
|
;---
|
|
Q 0
|