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

RORX009C.m

Go to the documentation of this file. 
  1. RORX009C ;HCIOFO/SG - PRESCRIPTION UTILIZ. (STORE) ;12/16/05 9:19am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**21,31,39**;Feb 17, 2006;Build 4
  1.  ;
  1.  ;******************************************************************************
  1.  ;                       --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;ROR*1.5*21   SEP 2013    T KOPP       Added ICN as last report column if
  1.  ;                                      additional identifier option selected
  1.  ;ROR*1.5*31   MAY 2017    M FERRARESE  Adding PACT, PCP, and AGE/DOB as additional
  1.  ;                                      identifiers.
  1.  ;ROR*1.5*39   JUL 2021    M FERRARESE  Setting SSN and LAST4 to zeros
  1.  ;******************************************************************************
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** DRUGS
  1.  ;
  1.  ; SECTION       IEN of the parent element
  1.  ;
  1.  ; SUBS
  1.  ;
  1.  ; NODE          Closed root of the category section
  1.  ;               in the temporary global
  1.  ;
  1.  ; TBLNAME
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. DRUGS(SECTION,SUBS,NODE,TBLNAME) ;
  1.  Q:$D(@NODE@(SUBS))<10 0
  1.  N IEN,ITEM,NAME,NRXNAME,NUM,RC,TMP
  1.  S TABLE=$$ADDVAL^RORTSK11(RORTSK,TBLNAME,,SECTION)
  1.  Q:TABLE<0 TABLE
  1.  D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE",TBLNAME)
  1.  S NRXNAME=$E(SUBS,1,2)_"NRX"
  1.  ;---
  1.  S NUM="",RC=0
  1.  F  S NUM=$O(@NODE@(SUBS,"B",NUM),-1)  Q:NUM=""  D  Q:RC
  1.  . S NAME=""
  1.  . F  S NAME=$O(@NODE@(SUBS,"B",NUM,NAME))  Q:NAME=""  D  Q:RC
  1.  . . S IEN=""
  1.  . . F  S IEN=$O(@NODE@(SUBS,"B",NUM,NAME,IEN))  Q:IEN=""  D  Q:RC
  1.  . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
  1.  . . . S TMP=+$G(@NODE@(SUBS,IEN,"P"))
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
  1.  . . . D ADDVAL^RORTSK11(RORTSK,NRXNAME,NUM,ITEM,3)
  1.  . . . S TMP=$G(@NODE@(SUBS,IEN,"M"))
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"MAXNRPP",+$P(TMP,U),ITEM,3)
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"MAXNP",+$P(TMP,U,2),ITEM,3)
  1.  Q $S(RC<0:RC,1:0)
  1.  ;
  1.  ;***** STORES THE REPORT DATA
  1.  ;
  1.  ; REPORT        IEN of the REPORT element
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. STORE(REPORT) ;
  1.  N RORSONLY      ; Output summary only
  1.  ;
  1.  N ECNT,NODE,RC,TMP
  1.  S RORSONLY=$$SMRYONLY^RORXU006(),(ECNT,RC)=0
  1.  S NODE=$NA(^TMP("RORX009",$J))
  1.  Q:$D(@NODE)<10 0
  1.  ;--- Outpatient data
  1.  S RC=$$LOOP^RORTSK01(0)  Q:RC<0 RC
  1.  S RC=$$STOREOP(REPORT,NODE)
  1.  I RC  Q:RC<0  S ECNT=ECNT+1
  1.  ;--- Inpatient data
  1.  S RC=$$LOOP^RORTSK01(.33)  Q:RC<0 RC
  1.  S RC=$$STOREIP(REPORT,NODE)
  1.  I RC  Q:RC<0  S ECNT=ECNT+1
  1.  ;--- Highest utilization summary
  1.  S RC=$$LOOP^RORTSK01(.66)  Q:RC<0 RC
  1.  S RC=$$STORESUM(REPORT,NODE)
  1.  I RC  Q:RC<0  S ECNT=ECNT+1
  1.  ;---
  1.  Q $S(RC<0:RC,1:ECNT)
  1.  ;
  1.  ;***** INPATIENT DATA
  1.  ;
  1.  ; PRNTELMT      IEN of the parent element
  1.  ;
  1.  ; NODE          Closed root of the category section
  1.  ;               in the temporary global
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. STOREIP(PRNTELMT,NODE) ;
  1.  Q:$D(@NODE@("IP"))<10 0
  1.  N BUF,COUNT,DFN,ITEM,MAXUTNUM,NAME,NRX,RC,SECTION,TABLE,TMP,AGETYPE
  1.  S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
  1.  S SECTION=$$ADDVAL^RORTSK11(RORTSK,"INPATIENTS",,PRNTELMT)
  1.  Q:SECTION<0 SECTION
  1.  S RC=0
  1.  S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
  1.  ;--- Number of doses
  1.  S TABLE=$$ADDVAL^RORTSK11(RORTSK,"DOSES",,SECTION)
  1.  Q:TABLE<0 TABLE
  1.  D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","DOSES")
  1.  S NRX=""
  1.  F  S NRX=$O(@NODE@("IPRX",NRX),-1)  Q:NRX=""  D
  1.  . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
  1.  . D ADDVAL^RORTSK11(RORTSK,"NP",$P(@NODE@("IPRX",NRX),U),ITEM,3)
  1.  . D ADDVAL^RORTSK11(RORTSK,"IPNRX",NRX,ITEM,3)
  1.  ;--- Drugs
  1.  S RC=$$DRUGS(SECTION,"IPD",NODE,"DRUGS_DOSES")  Q:RC<0 RC
  1.  ;--- Patients with highest utlization
  1.  I MAXUTNUM>0  D  Q:RC<0 RC
  1.  . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_DOSES",,SECTION)
  1.  . I TABLE<0  S RC=TABLE  Q
  1.  . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_DOSES")
  1.  . S NRX="",(COUNT,RC)=0
  1.  . F  S NRX=$O(@NODE@("IPRX",NRX),-1)  Q:NRX=""  D  Q:RC
  1.  . . S RC=$$LOOP^RORTSK01()  Q:RC<0
  1.  . . S NAME=""
  1.  . . F  S NAME=$O(@NODE@("IPRX",NRX,NAME))  Q:NAME=""  D  Q:RC
  1.  . . . S DFN=""
  1.  . . . F  S DFN=$O(@NODE@("IPRX",NRX,NAME,DFN))  Q:DFN=""  D  Q:RC
  1.  . . . . S COUNT=COUNT+1  I COUNT>MAXUTNUM  S RC=1  Q
  1.  . . . . S BUF=$G(@NODE@("IP",DFN)) S $P(BUF,U)="0000"
  1.  . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
  1.  . . . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(BUF,U,9),ITEM,1)
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,3),ITEM,1)
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"IPNRX",NRX,ITEM,3)
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"ND",$P(BUF,U,5),ITEM,3)
  1.  . . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D
  1.  . . . . . D ADDVAL^RORTSK11(RORTSK,"ICN",$P(BUF,U,6),ITEM,1)
  1.  . . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D
  1.  . . . . . D ADDVAL^RORTSK11(RORTSK,"PACT",$P(BUF,U,7),ITEM,1)
  1.  . . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D
  1.  . . . . . D ADDVAL^RORTSK11(RORTSK,"PCP",$P(BUF,U,8),ITEM,1)
  1.  ;--- Summary
  1.  D ADDVAL^RORTSK11(RORTSK,"NP",+$G(@NODE@("IP")),SECTION)
  1.  D ADDVAL^RORTSK11(RORTSK,"IPNRX",+$G(@NODE@("IPRX")),SECTION)
  1.  D ADDVAL^RORTSK11(RORTSK,"ND",+$G(@NODE@("IPD")),SECTION)
  1.  Q 0
  1.  ;
  1.  ;***** OUTPATIENT DATA
  1.  ;
  1.  ; PRNTELMT      IEN of the parent element
  1.  ;
  1.  ; NODE          Closed root of the category section
  1.  ;               in the temporary global
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. STOREOP(PRNTELMT,NODE) ;
  1.  Q:$D(@NODE@("OP"))<10 0
  1.  N BUF,COUNT,DFN,ITEM,MAXUTNUM,NAME,NRX,RC,SECTION,TABLE,TMP,AGETYPE
  1.  S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
  1.  S SECTION=$$ADDVAL^RORTSK11(RORTSK,"OUTPATIENTS",,PRNTELMT)
  1.  Q:SECTION<0 SECTION
  1.  S RC=0
  1.  ;--- Number of fills
  1.  S TABLE=$$ADDVAL^RORTSK11(RORTSK,"FILLS",,SECTION)
  1.  Q:TABLE<0 TABLE
  1.  D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","FILLS")
  1.  S NRX=""
  1.  S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
  1.  F  S NRX=$O(@NODE@("OPRX",NRX),-1)  Q:NRX=""  D
  1.  . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
  1.  . D ADDVAL^RORTSK11(RORTSK,"NP",$P(@NODE@("OPRX",NRX),U),ITEM,3)
  1.  . D ADDVAL^RORTSK11(RORTSK,"OPNRX",NRX,ITEM,3)
  1.  ;--- Drugs
  1.  S RC=$$DRUGS(SECTION,"OPD",NODE,"DRUGS_FILLS")  Q:RC<0 RC
  1.  ;--- Patients with highest utlization
  1.  I MAXUTNUM>0  D  Q:RC<0 RC
  1.  . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_FILLS",,SECTION)
  1.  . I TABLE<0  S RC=TABLE  Q
  1.  . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_FILLS")
  1.  . S NRX="",(COUNT,RC)=0
  1.  . F  S NRX=$O(@NODE@("OPRX",NRX),-1)  Q:NRX=""  D  Q:RC
  1.  . . S RC=$$LOOP^RORTSK01()  Q:RC<0
  1.  . . S NAME=""
  1.  . . F  S NAME=$O(@NODE@("OPRX",NRX,NAME))  Q:NAME=""  D  Q:RC
  1.  . . . S DFN=""
  1.  . . . F  S DFN=$O(@NODE@("OPRX",NRX,NAME,DFN))  Q:DFN=""  D  Q:RC
  1.  . . . . S COUNT=COUNT+1  I COUNT>MAXUTNUM  S RC=1  Q
  1.  . . . . S BUF=$G(@NODE@("OP",DFN)) S $P(BUF,U)="0000"
  1.  . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
  1.  . . . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(BUF,U,9),ITEM,1)
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,3),ITEM,1)
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"OPNRX",NRX,ITEM,3)
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"ND",$P(BUF,U,5),ITEM,3)
  1.  . . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D
  1.  . . . . . D ADDVAL^RORTSK11(RORTSK,"ICN",$P(BUF,U,6),ITEM,1)
  1.  . . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D
  1.  . . . . . D ADDVAL^RORTSK11(RORTSK,"PACT",$P(BUF,U,7),ITEM,1)
  1.  . . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D
  1.  . . . . . D ADDVAL^RORTSK11(RORTSK,"PCP",$P(BUF,U,8),ITEM,1)
  1.  ;--- Summary
  1.  D ADDVAL^RORTSK11(RORTSK,"NP",+$G(@NODE@("OP")),SECTION)
  1.  D ADDVAL^RORTSK11(RORTSK,"OPNRX",+$G(@NODE@("OPRX")),SECTION)
  1.  D ADDVAL^RORTSK11(RORTSK,"ND",+$G(@NODE@("OPD")),SECTION)
  1.  Q 0
  1.  ;
  1.  ;***** SUMMARY DATA
  1.  ;
  1.  ; PRNTELMT      IEN of the parent element
  1.  ;
  1.  ; NODE          Closed root of the category section
  1.  ;               in the temporary global
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. STORESUM(PRNTELMT,NODE) ;
  1.  N BUF,DFN,DOD,IPNRX,ITEM,LAST4,MAXUTNUM,NAME,NRX,OPNRX,RC,SECTION,TABLE,TMP,AGETYPE,PCP,PACT,ICN
  1.  S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
  1.  Q:($D(@NODE@("SUMRX"))<10)!(MAXUTNUM'>0) 0
  1.  ;---
  1.  S SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,PRNTELMT)
  1.  Q:SECTION<0 SECTION
  1.  S RC=0
  1.  ;--- Patients with highest utlization
  1.  S TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_NRX",,SECTION)
  1.  I TABLE<0  S RC=TABLE  Q
  1.  D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_NRX")
  1.  ;---
  1.  S NRX="",RC=0
  1.  S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
  1.  F  S NRX=$O(@NODE@("SUMRX",NRX),-1)  Q:NRX=""  D  Q:RC
  1.  . S RC=$$LOOP^RORTSK01()  Q:RC<0
  1.  . S NAME=""
  1.  . F  S NAME=$O(@NODE@("SUMRX",NRX,NAME))  Q:NAME=""  D  Q:RC
  1.  . . S DFN=""
  1.  . . F  S DFN=$O(@NODE@("SUMRX",NRX,NAME,DFN))  Q:DFN=""  D  Q:RC
  1.  . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
  1.  . . . S (IPNRX,OPNRX)=0
  1.  . . . S BUF=$G(@NODE@("OP",DFN)) S $P(BUF,U)="0000"
  1.  . . . S:BUF'="" LAST4=$P(BUF,U),DOD=$P(BUF,U,3),OPNRX=$P(BUF,U,4),ICN=$P(BUF,U,6),PACT=$P(BUF,U,7),PCP=$P(BUF,U,8),AGE=$P(BUF,U,9)
  1.  . . . S BUF=$G(@NODE@("IP",DFN))
  1.  . . . S:BUF'="" LAST4=$P(BUF,U),DOD=$P(BUF,U,3),IPNRX=$P(BUF,U,4),ICN=$P(BUF,U,6),PACT=$P(BUF,U,7),PCP=$P(BUF,U,8),AGE=$P(BUF,U,9)
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
  1.  . . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"OPNRX",OPNRX,ITEM,3)
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"IPNRX",IPNRX,ITEM,3)
  1.  . . . S TMP=+$G(@NODE@("SUMRX",NRX,NAME,DFN))
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"ND",TMP,ITEM,3)
  1.  . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
  1.  . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
  1.  . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D
  1.  . . . . D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
  1.  ;---
  1.  Q 0