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

RORXU007.m

Go to the documentation of this file. 
  1. RORXU007 ;HCIOFO/SG - PHARMACY-RELATED REPORT PARAMETERS ; 11/25/05 6:00pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #4533         ZERO^PSS50 (supported)
  1.  ; #4540         ZERO^PSN50P6 (supported)
  1.  ; #4543         IEN^PSN50P65 (supported)
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** PROCESSES THE "DRUGS" REPORT PARAMETER
  1.  ;
  1.  ; .RORTSK       Task number and task parameters
  1.  ;
  1.  ; PARTAG        Reference (IEN) to the parent tag
  1.  ;
  1.  ; .ROR8LST      Reference to a local variable, which contains a
  1.  ;               closed root of an array. IEN's of dispensed drugs
  1.  ;               will be returned into this array.
  1.  ;
  1.  ;                 @ROR8LTST@(DrugIEN,Group#) = ""
  1.  ;
  1.  ;               If this parameter is undefined or empty, then a
  1.  ;               temporary buffer is allocated by the $$ALLOC^RORTMP
  1.  ;               function and its root is returned via this parameter.
  1.  ;
  1.  ;               If all drugs are requested (the "ALL" attribute of
  1.  ;               the "DRUGS" tag), then "*" is returned.
  1.  ;
  1.  ; [.GRPLST]     Reference to a local variable that will contain
  1.  ;               the list of drug groups.
  1.  ;
  1.  ;                 GRPLST(
  1.  ;                   "C",Group#)    = GroupName
  1.  ;                   "N",GroupName) = Group#
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;       >0  IEN of the DRUGS element
  1.  ;
  1. DRUGLST(RORTSK,PARTAG,ROR8LST,GRPLST) ;
  1.  N LTAG,RC,RXALL,RXOPTS,TMP
  1.  S RXALL=+$$PARAM^RORTSK01("DRUGS","ALL")
  1.  S (LTAG,RC)=0
  1.  ;
  1.  ;=== Validate parameters
  1.  I RXALL  D  S ROR8LST="*"
  1.  . F TMP="INVESTIG","REGMDES"  K RORTSK("PARAMS","DRUGS","A",TMP)
  1.  E  D  K @ROR8LST
  1.  . S:$G(ROR8LST)="" ROR8LST=$$ALLOC^RORTMP()
  1.  . ;--- Aggregate by individual formulations if investigational
  1.  . ;--- medications are selected (they are not linked to generics)
  1.  . D:$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
  1.  . . N GRPNAME,INV,NODE
  1.  . . I '$$PARAM^RORTSK01("DRUGS","INVESTIG")  S INV=0  D  Q:'INV
  1.  . . . S NODE=$NA(RORTSK("PARAMS","DRUGS","G"))
  1.  . . . S GRPNAME=""
  1.  . . . F  S GRPNAME=$O(@NODE@(GRPNAME))  Q:GRPNAME=""  D  Q:INV
  1.  . . . . S:$G(@NODE@(GRPNAME,"A","INVESTIG")) INV=1
  1.  . . K RORTSK("PARAMS","DRUGS","A","AGGR_GENERIC")
  1.  . . S RORTSK("PARAMS","DRUGS","A","AGGR_FORMUL")=1
  1.  . . S RORTSK("PARAMS","DRUGS","A","AGGR_FORCED")=1
  1.  ;
  1.  ;=== Process the drug options (if present)
  1.  M RXOPTS=RORTSK("PARAMS","DRUGS","A")
  1.  I $D(RXOPTS)>1  D  Q:LTAG'>0 LTAG
  1.  . N ATTR,REGIEN
  1.  . S ATTR=$S(RXALL:"ALL",1:"")
  1.  . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",ATTR,PARTAG)
  1.  . Q:LTAG'>0
  1.  . ;--- Output option attributes
  1.  . S ATTR="",RC=0
  1.  . F  S ATTR=$O(RXOPTS(ATTR))  Q:ATTR=""  D  Q:RC<0
  1.  . . S RC=$$ADDATTR^RORTSK11(RORTSK,LTAG,ATTR,"1")
  1.  . I RC<0  S LTAG=RC  Q
  1.  . S ATTR=$$OPTXT^RORXU002(.RXOPTS)
  1.  . D:ATTR'="" ADDATTR^RORTSK11(RORTSK,LTAG,"DESCR",ATTR)
  1.  . ;--- Add registry-specific and/or investigational drugs
  1.  . Q:RXALL
  1.  . S REGIEN=+$$PARAM^RORTSK01("REGIEN"),TMP="AR"
  1.  . S:$G(RXOPTS("INVESTIG")) TMP=TMP_"C"
  1.  . S:$G(RXOPTS("REGMEDS")) TMP=TMP_"DG"
  1.  . S RC=$$DRUGLIST^RORUTL16(ROR8LST,REGIEN,TMP)
  1.  ;
  1.  ;=== Process the list of drugs (if present)
  1.  I 'RXALL  D:$D(RORTSK("PARAMS","DRUGS","G"))>1
  1.  . N GRPNAME,GRPTAG,IG,NODE
  1.  . I LTAG'>0  D  Q:LTAG'>0
  1.  . . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,PARTAG)
  1.  . ;---
  1.  . S NODE=$NA(RORTSK("PARAMS","DRUGS","G"))
  1.  . S GRPNAME="",RC=0
  1.  . F  S GRPNAME=$O(@NODE@(GRPNAME))  Q:GRPNAME=""  D  Q:RC<0
  1.  . . S IG=$O(GRPLST("C",""),-1)+1
  1.  . . S GRPLST("C",IG)=GRPNAME,GRPLST("N",GRPNAME)=IG
  1.  . . S GRPTAG=$$DRUGLST1(LTAG,GRPNAME,IG)
  1.  . . I GRPTAG'>0  S RC=GRPTAG  Q
  1.  . . ;--- Individual Formulations
  1.  . . S RC=$$DRUGLSTF(GRPTAG,GRPNAME,IG)  Q:RC<0
  1.  . . ;--- Generic Names
  1.  . . S RC=$$DRUGLSTG(GRPTAG,GRPNAME,IG)  Q:RC<0
  1.  . . ;--- Drug Classes
  1.  . . S RC=$$DRUGLSTC(GRPTAG,GRPNAME,IG)  Q:RC<0
  1.  ;
  1.  ;===
  1.  Q $S(RC<0:RC,1:LTAG)
  1.  ;
  1.  ;***** PROCESS THE GROUP ATTRIBUTES
  1.  ;
  1.  ; PTAG          Reference (IEN) to the parent tag
  1.  ; GRPNAME       Group Name
  1.  ; GRPCODE       Group Code (sequential number)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;       >0  IEN of the GROUP element
  1.  ;
  1. DRUGLST1(PTAG,GRPNAME,GRPCODE) ;
  1.  N GRPOPTS,GRPTAG,RC,TMP
  1.  ;--- Create the group tag
  1.  S GRPTAG=$$ADDVAL^RORTSK11(RORTSK,"GROUP",,PTAG)
  1.  Q:GRPTAG'>0 GRPTAG
  1.  D ADDATTR^RORTSK11(RORTSK,GRPTAG,"NAME",GRPNAME)
  1.  ;--- Process the group attributes
  1.  M GRPOPTS=RORTSK("PARAMS","DRUGS","G",GRPNAME,"A")
  1.  I $D(GRPOPTS)>1  S RC=0  D  Q:RC<0 RC
  1.  . N ATTR,REGIEN  S ATTR=""
  1.  . F  S ATTR=$O(GRPOPTS(ATTR))  Q:ATTR=""  D  Q:RC<0
  1.  . . S RC=$$ADDATTR^RORTSK11(RORTSK,GRPTAG,ATTR,"1")
  1.  . Q:RC<0
  1.  . S TMP=$$OPTXT^RORXU002(.GRPOPTS)
  1.  . D:TMP'="" ADDATTR^RORTSK11(RORTSK,GRPTAG,"DESCR",TMP)
  1.  . ;--- Add registry-specific and/or investigational drugs
  1.  . S REGIEN=+$$PARAM^RORTSK01("REGIEN"),TMP="AR"
  1.  . S:$G(GRPOPTS("INVESTIG")) TMP=TMP_"C"
  1.  . S:$G(GRPOPTS("REGMEDS")) TMP=TMP_"DG"
  1.  . S RC=$$DRUGLIST^RORUTL16(ROR8LST,REGIEN,TMP,GRPCODE)
  1.  ;---
  1.  Q GRPTAG
  1.  ;
  1.  ;***** PROCESS DRUG CLASSES
  1.  ;
  1.  ; PTAG          Reference (IEN) to the parent tag
  1.  ; GRPNAME       Group Name
  1.  ; GRPCODE       Group Code (sequential number)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;       >0  IEN of the VARXCLS element
  1.  ;
  1. DRUGLSTC(PTAG,GRPNAME,GRPCODE) ;
  1.  N CODE,IEN,LTAG,NODE,RORTMP,SUBS
  1.  S NODE=$NA(RORTSK("PARAMS","DRUGS","G",GRPNAME,"VARXCLS"))
  1.  Q:$D(@NODE)<10 0
  1.  S LTAG=$$ADDVAL^RORTSK11(RORTSK,"VARXCLS",,PTAG)
  1.  Q:LTAG<0 LTAG
  1.  ;---
  1.  S RORTMP=$$ALLOC^RORTMP(.SUBS)
  1.  S IEN=0
  1.  F  S IEN=$O(@NODE@(IEN))  Q:IEN'>0  D
  1.  . D IEN^PSN50P65(IEN,,SUBS)
  1.  . S CODE=$G(@RORTMP@(IEN,.01))  Q:CODE=""
  1.  . D ADDVAL^RORTSK11(RORTSK,"VARXCL",CODE,LTAG,,IEN)
  1.  . D RXADDVCL^RORUTL16(ROR8LST,IEN,1,GRPCODE)
  1.  D FREE^RORTMP(RORTMP)
  1.  ;---
  1.  Q LTAG
  1.  ;
  1.  ;***** PROCESS INDIVIDUAL FORMULATIONS
  1.  ;
  1.  ; PTAG          Reference (IEN) to the parent tag
  1.  ; GRPNAME       Group Name
  1.  ; GRPCODE       Group Code (sequential number)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;       >0  IEN of the FORMULATIONS element
  1.  ;
  1. DRUGLSTF(PTAG,GRPNAME,GRPCODE) ;
  1.  N IEN,LTAG,NAME,NODE,RORTMP,SUBS
  1.  S NODE=$NA(RORTSK("PARAMS","DRUGS","G",GRPNAME,"FORMULATIONS"))
  1.  Q:$D(@NODE)<10 0
  1.  S LTAG=$$ADDVAL^RORTSK11(RORTSK,"FORMULATIONS",,PTAG)
  1.  Q:LTAG<0 LTAG
  1.  ;---
  1.  S RORTMP=$$ALLOC^RORTMP(.SUBS)
  1.  S IEN=0
  1.  F  S IEN=$O(@NODE@(IEN))  Q:IEN'>0  D
  1.  . D ZERO^PSS50(IEN,,,,,SUBS)
  1.  . S NAME=$G(@RORTMP@(IEN,.01))  Q:NAME=""
  1.  . D ADDVAL^RORTSK11(RORTSK,"DRUG",NAME,LTAG,,IEN)
  1.  . S @ROR8LST@(IEN,GRPCODE)=""
  1.  D FREE^RORTMP(RORTMP)
  1.  ;---
  1.  Q LTAG
  1.  ;
  1.  ;***** PROCESS GENERIC NAMES
  1.  ;
  1.  ; PTAG          Reference (IEN) to the parent tag
  1.  ; GRPNAME       Group Name
  1.  ; GRPCODE       Group Code (sequential number)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;       >0  IEN of the GENERIC element
  1.  ;
  1. DRUGLSTG(PTAG,GRPNAME,GRPCODE) ;
  1.  N IEN,LTAG,NAME,NODE,RORTMP,SUBS
  1.  S NODE=$NA(RORTSK("PARAMS","DRUGS","G",GRPNAME,"GENERIC"))
  1.  Q:$D(@NODE)<10 0
  1.  S LTAG=$$ADDVAL^RORTSK11(RORTSK,"GENERIC",,PTAG)
  1.  Q:LTAG<0 LTAG
  1.  ;---
  1.  S RORTMP=$$ALLOC^RORTMP(.SUBS)
  1.  S IEN=0
  1.  F  S IEN=$O(@NODE@(IEN))  Q:IEN'>0  D
  1.  . D ZERO^PSN50P6(IEN,,,,SUBS)
  1.  . S NAME=$G(@RORTMP@(IEN,.01))  Q:NAME=""
  1.  . D ADDVAL^RORTSK11(RORTSK,"DRUG",NAME,LTAG,,IEN)
  1.  . D RXADDGEN^RORUTL16(ROR8LST,IEN,1,GRPCODE)
  1.  D FREE^RORTMP(RORTMP)
  1.  ;---
  1.  Q LTAG
  1.  ;
  1.  ;***** FUNCTION FOR THE PHARMACY SEARCH API
  1.  ;
  1.  ; .RORDST       Reference to the search descriptor
  1.  ; DRUGIEN       IEN of an individual formulation (dispensed drug)
  1.  ; ROR8LST       Closed root of the drug list generated by the
  1.  ;               $$DRUGLST^RORXU007 function or "*" for all drugs.
  1.  ;
  1.  ; Return Values:
  1.  ;        0  Ok
  1.  ;        1  Skip the record
  1.  ;
  1. RXGRPCHK(RORDST,DRUGIEN,ROR8LST) ;
  1.  Q:ROR8LST="*" 0
  1.  Q:$D(@ROR8LST@(DRUGIEN))<10 1
  1.  N GRP  S GRP=""
  1.  F  S GRP=$O(@ROR8LST@(DRUGIEN,GRP))  Q:GRP=""  D
  1.  . K RORDST("RORXGRP",GRP)
  1.  Q 0