- RORX014 ;HOIFO/SG - REGISTRY MEDICATIONS REPORT ;11/25/05 5:57pm
- ;;1.5;CLINICAL CASE REGISTRIES;**21,31**;Feb 17, 2006;Build 62
- ;
- Q
- ;******************************************************************************
- ; --- ROUTINE MODIFICATION LOG ---
- ;
- ;PKG/PATCH DATE DEVELOPER MODIFICATION
- ;----------- ---------- ----------- ----------------------------------------
- ;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.
- ;******************************************************************************
- ;
- ;***** OUTPUTS THE REPORT HEADER
- ;
- ; PARTAG Reference (IEN) to the parent tag
- ;
- ; Return Values:
- ; <0 Error code
- ; >0 IEN of the HEADER element
- ;
- ;;RXCOMBLST(NP,PATIENTS(NAME,LAST4,DOD,ICN,PACT,PCP))^I $$PARAM^RORTSK01("OPTIONS","COMPLETE"),$$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
- ;;RXCOMBLST(NP,PATIENTS(NAME,LAST4,AGE,DOD,ICN,PACT,PCP))^I $$PARAM^RORTSK01("OPTIONS","COMPLETE"),$$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
- ;;RXCOMBLST(NP,PATIENTS(NAME,LAST4,DOB,DOD,ICN,PACT,PCP))^I $$PARAM^RORTSK01("OPTIONS","COMPLETE"),$$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
- ;;RXCOMBLST(NP,RXCOMB)^I $$PARAM^RORTSK01("OPTIONS","SUMMARY")
- ;
- N HEADER,RC
- S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
- Q:HEADER<0 HEADER
- S RC=$$TBLDEF^RORXU002("HEADER^RORX014",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,RC
- S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
- Q:PARAMS<0 PARAMS
- ;--- Process the drug list and options
- S RORTSK("PARAMS","DRUGS","A","REGMEDS")=1
- S RORTSK("PARAMS","DRUGS","A","AGGR_GENERIC")=1
- S RC=$$DRUGLST^RORXU007(.RORTSK,PARAMS,.RORXL)
- Q:RC<0 RC
- ;--- Success
- Q PARAMS
- ;
- ;***** COMPILES THE "REGISTRY MEDICATIONS" REPORT
- ; REPORT CODE: 014
- ;
- ; .RORTSK Task number and task parameters
- ;
- ; The ^TMP("RORX014",$J) global node is used by this function.
- ;
- ; ^TMP("RORX014",$J,
- ; "DRG",
- ; DrugIEN) Medication name (generic or formulation)
- ; "RXC",
- ; RxcIEN,
- ; 1) List of Drug IEN's separated by ","
- ; "P" Number of patients
- ; DFN) Patient Descriptor
- ; ^01: Las 4 digits of SSN
- ; ^02: Name
- ; ^03: Date of Death
- ; ^04: ICN
- ; ^05: Age/DOB
- ; "B",
- ; RxcNdx,
- ; RxcIEN) ""
- ; "P",
- ; NumOfPat,
- ; RxcIEN) ""
- ;
- ; RxcNdx is the first 100 characters of the list of Drug IEN's.
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ;
- RXCOMB(RORTSK) ;
- N ROREDT ; End date
- N ROREDT1 ; End date + 1
- N RORREG ; Registry IEN
- N RORSDT ; Start date
- N RORXL ; Drug list for the pharmacy search API
- ;
- N ECNT,NRXC,RC,REPORT,SFLAGS,TMP
- S RORXL="",(ECNT,RC)=0
- K ^TMP("RORX014",$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 RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.SFLAGS) Q:RC<0
- . S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
- . ;--- Report header
- . S RC=$$HEADER(REPORT) Q:RC<0
- . ;--- Query the registry
- . D TPPSETUP^RORTSK01(80)
- . S RC=$$QUERY^RORX014A(SFLAGS)
- . I RC Q:RC<0 S ECNT=ECNT+RC
- . ;--- Sort the data
- . D TPPSETUP^RORTSK01(5)
- . S RC=$$SORT^RORX014A(.NRXC)
- . I RC Q:RC<0 S ECNT=ECNT+RC
- . ;--- Store the results
- . D TPPSETUP^RORTSK01(15)
- . S RC=$$STORE^RORX014A(REPORT,NRXC)
- . I RC Q:RC<0 S ECNT=ECNT+RC
- ;
- ;--- Cleanup
- K ^TMP("RORX014",$J)
- D FREE^RORTMP(RORXL)
- Q $S(RC<0:RC,ECNT>0:-43,1:0)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX014 4482 printed Feb 18, 2025@23:11:03 Page 2
- RORX014 ;HOIFO/SG - REGISTRY MEDICATIONS REPORT ;11/25/05 5:57pm
- +1 ;;1.5;CLINICAL CASE REGISTRIES;**21,31**;Feb 17, 2006;Build 62
- +2 ;
- +3 QUIT
- +4 ;******************************************************************************
- +5 ; --- ROUTINE MODIFICATION LOG ---
- +6 ;
- +7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
- +8 ;----------- ---------- ----------- ----------------------------------------
- +9 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
- +10 ; additional identifier option selected
- +11 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
- +12 ; identifiers.
- +13 ;******************************************************************************
- +14 ;
- +15 ;***** OUTPUTS THE REPORT HEADER
- +16 ;
- +17 ; PARTAG Reference (IEN) to the parent tag
- +18 ;
- +19 ; Return Values:
- +20 ; <0 Error code
- +21 ; >0 IEN of the HEADER element
- +22 ;
- +1 ;;RXCOMBLST(NP,PATIENTS(NAME,LAST4,DOD,ICN,PACT,PCP))^I $$PARAM^RORTSK01("OPTIONS","COMPLETE"),$$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
- +2 ;;RXCOMBLST(NP,PATIENTS(NAME,LAST4,AGE,DOD,ICN,PACT,PCP))^I $$PARAM^RORTSK01("OPTIONS","COMPLETE"),$$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
- +3 ;;RXCOMBLST(NP,PATIENTS(NAME,LAST4,DOB,DOD,ICN,PACT,PCP))^I $$PARAM^RORTSK01("OPTIONS","COMPLETE"),$$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
- +4 ;;RXCOMBLST(NP,RXCOMB)^I $$PARAM^RORTSK01("OPTIONS","SUMMARY")
- +5 ;
- +6 NEW HEADER,RC
- +7 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
- +8 if HEADER<0
- QUIT HEADER
- +9 SET RC=$$TBLDEF^RORXU002("HEADER^RORX014",HEADER)
- +10 QUIT $SELECT(RC<0:RC,1:HEADER)
- +11 ;
- +12 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
- +13 ;
- +14 ; PARTAG Reference (IEN) to the parent tag
- +15 ;
- +16 ; [.STDT] Start and end dates of the report
- +17 ; [.ENDT] are returned via these parameters
- +18 ;
- +19 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are
- +20 ; returned via this parameter
- +21 ;
- +22 ; Return Values:
- +23 ; <0 Error code
- +24 ; >0 IEN of the PARAMETERS element
- +25 ;
- PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
- +1 NEW PARAMS,RC
- +2 SET PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
- +3 if PARAMS<0
- QUIT PARAMS
- +4 ;--- Process the drug list and options
- +5 SET RORTSK("PARAMS","DRUGS","A","REGMEDS")=1
- +6 SET RORTSK("PARAMS","DRUGS","A","AGGR_GENERIC")=1
- +7 SET RC=$$DRUGLST^RORXU007(.RORTSK,PARAMS,.RORXL)
- +8 if RC<0
- QUIT RC
- +9 ;--- Success
- +10 QUIT PARAMS
- +11 ;
- +12 ;***** COMPILES THE "REGISTRY MEDICATIONS" REPORT
- +13 ; REPORT CODE: 014
- +14 ;
- +15 ; .RORTSK Task number and task parameters
- +16 ;
- +17 ; The ^TMP("RORX014",$J) global node is used by this function.
- +18 ;
- +19 ; ^TMP("RORX014",$J,
- +20 ; "DRG",
- +21 ; DrugIEN) Medication name (generic or formulation)
- +22 ; "RXC",
- +23 ; RxcIEN,
- +24 ; 1) List of Drug IEN's separated by ","
- +25 ; "P" Number of patients
- +26 ; DFN) Patient Descriptor
- +27 ; ^01: Las 4 digits of SSN
- +28 ; ^02: Name
- +29 ; ^03: Date of Death
- +30 ; ^04: ICN
- +31 ; ^05: Age/DOB
- +32 ; "B",
- +33 ; RxcNdx,
- +34 ; RxcIEN) ""
- +35 ; "P",
- +36 ; NumOfPat,
- +37 ; RxcIEN) ""
- +38 ;
- +39 ; RxcNdx is the first 100 characters of the list of Drug IEN's.
- +40 ;
- +41 ; Return Values:
- +42 ; <0 Error code
- +43 ; 0 Ok
- +44 ;
- RXCOMB(RORTSK) ;
- +1 ; End date
- NEW ROREDT
- +2 ; End date + 1
- NEW ROREDT1
- +3 ; Registry IEN
- NEW RORREG
- +4 ; Start date
- NEW RORSDT
- +5 ; Drug list for the pharmacy search API
- NEW RORXL
- +6 ;
- +7 NEW ECNT,NRXC,RC,REPORT,SFLAGS,TMP
- +8 SET RORXL=""
- SET (ECNT,RC)=0
- +9 KILL ^TMP("RORX014",$JOB)
- +10 ;--- Root node of the report
- +11 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
- +12 if REPORT<0
- QUIT REPORT
- +13 ;
- +14 Begin DoDot:1
- +15 ;--- Get and prepare the report parameters
- +16 SET RORREG=$$PARAM^RORTSK01("REGIEN")
- +17 SET RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.SFLAGS)
- if RC<0
- QUIT
- +18 SET ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
- +19 ;--- Report header
- +20 SET RC=$$HEADER(REPORT)
- if RC<0
- QUIT
- +21 ;--- Query the registry
- +22 DO TPPSETUP^RORTSK01(80)
- +23 SET RC=$$QUERY^RORX014A(SFLAGS)
- +24 IF RC
- if RC<0
- QUIT
- SET ECNT=ECNT+RC
- +25 ;--- Sort the data
- +26 DO TPPSETUP^RORTSK01(5)
- +27 SET RC=$$SORT^RORX014A(.NRXC)
- +28 IF RC
- if RC<0
- QUIT
- SET ECNT=ECNT+RC
- +29 ;--- Store the results
- +30 DO TPPSETUP^RORTSK01(15)
- +31 SET RC=$$STORE^RORX014A(REPORT,NRXC)
- +32 IF RC
- if RC<0
- QUIT
- SET ECNT=ECNT+RC
- End DoDot:1
- +33 ;
- +34 ;--- Cleanup
- +35 KILL ^TMP("RORX014",$JOB)
- +36 DO FREE^RORTMP(RORXL)
- +37 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)