Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORX023

RORX023.m

Go to the documentation of this file. 
  1. RORX023 ;ALB/TMK -  HCV SUSTAINED VIROLOGIC RESPONSE REPORT ;7/21/11 1:04pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**24,31**;Feb 17, 2006;Build 62
  1.  ;
  1.  ;******************************************************************************
  1.  ;                       --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;ROR*1.5*24   JUN 2014    T KOPP       Created report
  1.  ;ROR*1.5*31   MAY 2017    M FERRARESE  Adding PACT, PCP, and AGE/DOB as additional
  1.  ;                                      identifiers.
  1.  ;******************************************************************************
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** OUTPUTS THE REPORT HEADER
  1.  ;
  1.  ; PARTAG        Reference (IEN) to the parent tag
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;       >0  IEN of the HEADER element
  1.  ;
  1.  ;;PATIENTS(#,NAME,LAST4,HCV_DATE,HCV,GT,LAST_TAKEN,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
  1.  ;;PATIENTS(#,NAME,LAST4,AGE,HCV_DATE,HCV,GT,LAST_TAKEN,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
  1.  ;;PATIENTS(#,NAME,LAST4,DOB,HCV_DATE,HCV,GT,LAST_TAKEN,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
  1.  ;
  1.  N HEADER,RC
  1.  S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
  1.  Q:HEADER<0 HEADER
  1.  S RC=$$TBLDEF^RORXU002("HEADER^RORX023",HEADER)
  1.  Q $S(RC<0:RC,1:HEADER)
  1.  ;
  1.  ;***** COMPILES THE "SUSTAINED VIROLOGIC RESPONSE" REPORT
  1.  ; REPORT CODE: 023
  1.  ;
  1.  ; .RORTSK       Task number and task parameters
  1.  ;
  1.  ; The ^TMP("RORX023",$J) global node is used by this function.
  1.  ;
  1.  ; ^TMP("RORX023",$J,
  1.  ;   "PAT",
  1.  ;     DFN,              Patient descriptor
  1.  ;                         ^01: Last 4 digits of SSN
  1.  ;                         ^02: Patient name
  1.  ;                         ^03: empty
  1.  ;                         ^04: National ICN
  1.  ;                         ^05: Patient Care Team
  1.  ;                         ^06: Priamary Care Provider
  1.  ;                         ^07: Age/DOB
  1.  ;       "LR",
  1.  ;         Category,
  1.  ;           Date(inverse) = Result
  1.  ;            
  1.  ;       "RX",
  1.  ;         Last Taken Date) = ""
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. HCVSVR(RORTSK) ;
  1.  N RORLTST       ; Closed root of the list of lab tests for the
  1.  ;               ; Lab search API
  1.  N RORREG        ; Registry IEN
  1.  N RORSDT       ; Pharmacy start date
  1.  N ROREDT       ; Pharmacy end date
  1.  N RORXGRP       ; List of drug groups
  1.  N RORXL         ; Closed root of the drug list for the pharmacy
  1.  ;               ; search API 
  1.  N ECNT,NSPT,RC,SFLAGS,TMP,BUF,RORXEDT,RORXSDT
  1.  N REPORT,PARAMS,ELEMENT  ;XML parent variables
  1.  ;
  1.  S (RORXL,RORLTST)="",(ECNT,RC)=0
  1.  K ^TMP("RORX023",$J)
  1.  ;--- Root node of the report
  1.  S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
  1.  Q:REPORT<0 REPORT
  1.  ;
  1.  ;--- Get and prepare the report parameters
  1.  D
  1.  . S RORREG=$$PARAM^RORTSK01("REGIEN")  ; Registry IEN
  1.  . S PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,.RORXSDT,.RORXEDT,.SFLAGS)
  1.  . Q:PARAMS<0
  1.  . S TMP=""
  1.  . F  S TMP=$O(BUF(TMP))  Q:TMP=""  D  Q:RC<0
  1.  . . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,TMP,BUF(TMP))
  1.  . ;--- Report header
  1.  . S RC=$$HEADER(REPORT)  Q:RC<0
  1.  . ;--- Query the registry
  1.  . D TPPSETUP^RORTSK01(80)
  1.  . S RC=$$QUERY^RORX023A(REPORT,SFLAGS,.NSPT)
  1.  . I RC Q:RC<0  S ECNT=ECNT+RC
  1.  . ;--- Store the results
  1.  . D TPPSETUP^RORTSK01(20)
  1.  . S RC=$$STORE^RORX023A(REPORT,NSPT)
  1.  . I RC Q:RC<0  S ECNT=ECNT+RC
  1.  ;
  1.  ;--- Cleanup
  1.  K ^TMP("RORX023",$J)
  1.  ;
  1.  Q $S(RC<0:RC,ECNT>0:-43,1:0)