RORX011 ;HCIOFO/SG - PATIENT MEDICATION HISTORY ; 6/22/06 10:56am
 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
 ;
 Q
 ;
 ;***** OUTPUTS THE REPORT HEADER
 ;
 ; PARTAG        Reference (IEN) to the parent tag
 ;
 ; Return Values:
 ;       <0  Error code
 ;       >0  IEN of the HEADER element
 ;
HEADER(PARTAG) ;
 ;;PATIENTS(#,NAME,LAST4,DOB,AGE,DOD)
 ;;PTRXL(DATE,ORDER,TYPE,NAME,GENERIC,DAYSPLY,FILLTYPE)
 ;
 N HEADER,NOTES,RC
 S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
 Q:HEADER<0 HEADER
 S NOTES=$$ADDVAL^RORTSK11(RORTSK,"NOTES",,HEADER)
 D ADDVAL^RORTSK11(RORTSK,"AGE",$$DT^XLFDT,NOTES)
 S RC=$$TBLDEF^RORXU002("HEADER^RORX011",HEADER)
 Q $S(RC<0:RC,1:HEADER)
 ;
 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
 ;
 ; PARTAG        Reference (IEN) to the parent tag
 ;
 ; [.STDT]       Start and end dates of the report
 ; [.ENDT]       are returned via these parameters
 ;
 ; [.FLAGS]      Flags for the $$SKIP^RORXU005 are
 ;               returned via this parameter
 ;
 ; Return Values:
 ;       <0  Error code
 ;       >0  IEN of the PARAMETERS element
 ;
PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
 N PARAMS,TMP
 S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
 Q:PARAMS<0 PARAMS
 ;--- Process the drug list and options
 S TMP=$$DRUGLST^RORXU007(.RORTSK,PARAMS,.RORXL,.RORXGRP)
 Q:TMP<0 TMP
 ;---
 Q PARAMS
 ;
 ;***** PROCESS THE PATIENT'S DATA
 ;
 ; PTLIST        Reference (IEN) to the parent tag
 ; PATIEN        Patient IEN in the file #2 (DFN)
 ;
 ; Return Values:
 ;       <0  Error code
 ;        0  Ok
 ;       >0  Number of non-fatal errors
 ;
PATIENT(PTLIST,PATIEN) ;
 N BUF,FLT,FLTL,FQL,ITEM,NODE,PTAG,QSB,RC,TABLE,VA,VADM,VAERR
 S (ECNT,RC)=0
 ;--- Patient data
 S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLIST,,PATIEN)
 Q:PTAG<0 PTAG
 D VADEM^RORUTL05(PATIEN,1)
 D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
 D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
 D ADDVAL^RORTSK11(RORTSK,"DOB",$$DATE^RORXU002(VADM(3)\1),PTAG,1)
 D ADDVAL^RORTSK11(RORTSK,"AGE",VADM(4),PTAG,3)
 D ADDVAL^RORTSK11(RORTSK,"DOD",$$DATE^RORXU002(VADM(6)\1),PTAG,1)
 ;--- List of drugs
 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PTRXL",,PTAG)
 Q:TABLE<0 TABLE
 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PTRXL")
 ;---
 S NODE=RORXDST,FLTL=$L(NODE)-1,FLT=$E(NODE,1,FLTL)
 S QSB=$QL(NODE),FQL=QSB+5
 F  S NODE=$Q(@NODE)  Q:$E(NODE,1,FLTL)'=FLT  D:$QL(NODE)=FQL
 . ; NODE: @RORXDST@(DATE,DRUGNAME,DRUGIEN,RXNUM,RXCNT)
 . S BUF=@NODE
 . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
 . D ADDVAL^RORTSK11(RORTSK,"DATE",$QS(NODE,QSB+1)\1,ITEM,1)
 . D ADDVAL^RORTSK11(RORTSK,"ORDER",$QS(NODE,QSB+4),ITEM,1)
 . S TMP=$P(BUF,U)
 . S TMP=$S(TMP="O":"ORIGINAL",TMP="P":"PARTIAL",TMP="R":"REFILL",1:"")
 . D ADDVAL^RORTSK11(RORTSK,"TYPE",TMP,ITEM,1)
 . D ADDVAL^RORTSK11(RORTSK,"NAME",$QS(NODE,QSB+2),ITEM,1)
 . D ADDVAL^RORTSK11(RORTSK,"GENERIC",$P(BUF,U,4),ITEM,1)
 . D ADDVAL^RORTSK11(RORTSK,"DAYSPLY",$P(BUF,U,5),ITEM,1)
 . S TMP=$P(BUF,U,2)
 . S TMP=$S(TMP="I":"INPATIENT",TMP="M":"MAIL",TMP="W":"WINDOW",1:"")
 . D ADDVAL^RORTSK11(RORTSK,"FILLTYPE",TMP,ITEM,1)
 ;---
 Q $S(RC<0:RC,1:ECNT)
 ;
 ;***** PROCESSES THE LIST OF PATIENTS
 ;
 ; REPORT        Reference (IEN) to the parent tag
 ;
 ; Return Values:
 ;       <0  Error code
 ;        0  Ok
 ;       >0  Number of non-fatal errors
 ;
PROCESS(REPORT,FLAGS) ;
 N CNT,ECNT,IEN798,PTIEN,PTLIST,PTNODE,RC,RORPTN,RORXDST,RXFLAGS,TMP
 S (CNT,ECNT,RC)=0
 ;
 ;--- Count patients in the list
 I RORALL  D  S:RORPTN<0 RORPTN=0
 . S PTNODE=$NA(^RORDATA(798,"ARP",RORREG_"#"))
 . S RORPTN=$$REGSIZE^RORUTL02(+RORREG)
 E  S (PTIEN,RORPTN)=0  D  Q:RORPTN'>0 0
 . S PTNODE=$NA(RORTSK("PARAMS","PATIENTS","C"))
 . F  S PTIEN=$O(@PTNODE@(PTIEN))  Q:PTIEN'>0  S RORPTN=RORPTN+1
 ;---
 S PTLIST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
 Q:PTLIST<0 PTLIST
 ;
 ;--- Prepare parameters for the pharmacy search API
 S RORXDST=$NA(^TMP("RORX011",$J))
 S RORXDST("RORCB")="$$RXSCB^RORX011"
 S RXFLAGS="E"
 S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") RXFLAGS=RXFLAGS_"IV"
 S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") RXFLAGS=RXFLAGS_"O"
 ;
 ;--- Browse through the list of patients
 S (CNT,PTIEN)=0
 F  S PTIEN=$O(@PTNODE@(PTIEN))  Q:PTIEN'>0  D  Q:RC<0
 . S RC=$$LOOP^RORTSK01(CNT/RORPTN)  Q:RC<0
 . S CNT=CNT+1,IEN798=$$PRRIEN^RORUTL01(PTIEN,RORREG)  Q:IEN798'>0
 . ;--- Check if the patient should be skipped
 . I RORALL  Q:$$SKIP^RORXU005(IEN798,FLAGS,RORSDT,ROREDT)
 . ;--- Search the pharmacy data
 . K @RORXDST
 . S TMP=$$RXSEARCH^RORUTL14(PTIEN,RORXL,.RORXDST,RXFLAGS,RORSDT,ROREDT1)
 . I TMP<0  S ECNT=ECNT+1  Q
 . I RORALL  Q:TMP'>0
 . ;--- Append the patient's data to the report
 . S TMP=$$PATIENT(PTLIST,PTIEN)
 . I TMP  S ECNT=ECNT+$S(TMP>0:TMP,1:1)  Q
 ;
 ;--- Cleanup
 K @RORXDST
 Q $S(RC<0:RC,1:ECNT)
 ;
 ;***** COMPILES THE "PATIENT DRUG HISTORY" REPORT
 ; REPORT CODE: 011
 ;
 ; .RORTSK       Task number and task parameters
 ;
 ; The ^TMP("RORX011",$J) global node is used by this function.
 ;
 ; Return Values:
 ;       <0  Error code
 ;        0  Ok
 ;
RXHIST(RORTSK) ;
 N RORALL        ; Consider all registry patients
 N ROREDT        ; End date
 N ROREDT1       ; End date + 1
 N RORREG        ; Registry IEN
 N RORSDT        ; Start date
 N RORXGRP       ; List of drug groups
 N RORXL         ; Closed root of the medication list
 ;
 N ECNT,FLAGS,RC,REPORT,TMP
 S RORXL="",(ECNT,RC)=0
 K ^TMP("RORX011",$J)
 ;
 ;--- Root node of the report
 S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
 Q:REPORT<0 REPORT
 ;
 D
 . ;--- Get and prepare the report parameters
 . S RORREG=+$$PARAM^RORTSK01("REGIEN")
 . S RORALL=$$PARAM^RORTSK01("PATIENTS","ALL")
 . S RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.FLAGS)  Q:RC<0
 . S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
 . ;
 . ;--- Report header
 . S RC=$$HEADER(REPORT)  Q:RC<0
 . ;
 . ;--- Process the data and generate the report
 . S RC=$$PROCESS(REPORT,FLAGS)  S:RC>0 ECNT=ECNT+RC
 ;
 ;--- Cleanup
 K ^TMP("RORX011",$J)
 D FREE^RORTMP(RORXL)
 Q $S(RC<0:RC,ECNT>0:-43,1:0)
 ;
 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
 N DRUGIEN,DRUGNAME,FILLTYPE,IEN,IRP,OFD,RPSUB,RXBUF,RXCNT,RXNUM,TMP
 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:ROR8DST("RORXGEN")>0 $P(RXBUF,U,4)=$P(ROR8DST("RORXGEN"),U,2)
 S $P(RXBUF,U,5)=$P($G(^TMP("PS",$J,0)),U,7)  ; Days Supply
 S TMP=$G(^TMP("PS",$J,"RXN",0))
 S FILLTYPE=$S(ORDFLG["I":"I",1:$P(TMP,U,3))
 S RXNUM=$P(TMP,U)  S:RXNUM="" RXNUM=" "
 S RXCNT=0
 ;--- Original prescription
 I ORDFLG["I"  D  ;--- Inpatient
 . S OFD=$P($G(^TMP("PS",$J,0)),U,5)         ; Start Date
 . S $P(RXBUF,U,1,2)="I"_U_FILLTYPE,RXCNT=RXCNT+1
 . S @ROR8DST@(OFD,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
 E  D             ;--- Outpatient
 . S OFD=+$P($G(^TMP("PS",$J,"RXN",0)),U,6)  ; Original Fill Date
 . Q:(OFD<ROR8DST("RORSDT"))!(OFD'<ROR8DST("ROREDT"))
 . S $P(RXBUF,U,1,2)="O"_U_FILLTYPE,RXCNT=RXCNT+1
 . S @ROR8DST@(OFD,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
 ;--- Refills and partials
 F RPSUB="REF","PAR"  D
 . S $P(RXBUF,U)=$E(RPSUB,1)
 . S IRP=0
 . F  S IRP=$O(^TMP("PS",$J,RPSUB,IRP))  Q:IRP'>0  D
 . . S TMP=$G(^TMP("PS",$J,RPSUB,IRP,0))
 . . S $P(RXBUF,U,2)=$S(ORDFLG["I":"I",1:$P(TMP,U,5))
 . . S $P(RXBUF,U,5)=$P(TMP,U,2)  ; Days Supply
 . . I TMP>0  S RXCNT=RXCNT+1  D
 . . . S @ROR8DST@(+TMP,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
 Q 0