RORXU007 ;HCIOFO/SG - PHARMACY-RELATED REPORT PARAMETERS ; 11/25/05 6:00pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; This routine uses the following IAs:
;
; #4533 ZERO^PSS50 (supported)
; #4540 ZERO^PSN50P6 (supported)
; #4543 IEN^PSN50P65 (supported)
;
Q
;
;***** PROCESSES THE "DRUGS" REPORT PARAMETER
;
; .RORTSK Task number and task parameters
;
; PARTAG Reference (IEN) to the parent tag
;
; .ROR8LST Reference to a local variable, which contains a
; closed root of an array. IEN's of dispensed drugs
; will be returned into this array.
;
; @ROR8LTST@(DrugIEN,Group#) = ""
;
; If this parameter is undefined or empty, then a
; temporary buffer is allocated by the $$ALLOC^RORTMP
; function and its root is returned via this parameter.
;
; If all drugs are requested (the "ALL" attribute of
; the "DRUGS" tag), then "*" is returned.
;
; [.GRPLST] Reference to a local variable that will contain
; the list of drug groups.
;
; GRPLST(
; "C",Group#) = GroupName
; "N",GroupName) = Group#
;
; Return Values:
; <0 Error code
; >0 IEN of the DRUGS element
;
DRUGLST(RORTSK,PARTAG,ROR8LST,GRPLST) ;
N LTAG,RC,RXALL,RXOPTS,TMP
S RXALL=+$$PARAM^RORTSK01("DRUGS","ALL")
S (LTAG,RC)=0
;
;=== Validate parameters
I RXALL D S ROR8LST="*"
. F TMP="INVESTIG","REGMDES" K RORTSK("PARAMS","DRUGS","A",TMP)
E D K @ROR8LST
. S:$G(ROR8LST)="" ROR8LST=$$ALLOC^RORTMP()
. ;--- Aggregate by individual formulations if investigational
. ;--- medications are selected (they are not linked to generics)
. D:$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
. . N GRPNAME,INV,NODE
. . I '$$PARAM^RORTSK01("DRUGS","INVESTIG") S INV=0 D Q:'INV
. . . S NODE=$NA(RORTSK("PARAMS","DRUGS","G"))
. . . S GRPNAME=""
. . . F S GRPNAME=$O(@NODE@(GRPNAME)) Q:GRPNAME="" D Q:INV
. . . . S:$G(@NODE@(GRPNAME,"A","INVESTIG")) INV=1
. . K RORTSK("PARAMS","DRUGS","A","AGGR_GENERIC")
. . S RORTSK("PARAMS","DRUGS","A","AGGR_FORMUL")=1
. . S RORTSK("PARAMS","DRUGS","A","AGGR_FORCED")=1
;
;=== Process the drug options (if present)
M RXOPTS=RORTSK("PARAMS","DRUGS","A")
I $D(RXOPTS)>1 D Q:LTAG'>0 LTAG
. N ATTR,REGIEN
. S ATTR=$S(RXALL:"ALL",1:"")
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",ATTR,PARTAG)
. Q:LTAG'>0
. ;--- Output option attributes
. S ATTR="",RC=0
. F S ATTR=$O(RXOPTS(ATTR)) Q:ATTR="" D Q:RC<0
. . S RC=$$ADDATTR^RORTSK11(RORTSK,LTAG,ATTR,"1")
. I RC<0 S LTAG=RC Q
. S ATTR=$$OPTXT^RORXU002(.RXOPTS)
. D:ATTR'="" ADDATTR^RORTSK11(RORTSK,LTAG,"DESCR",ATTR)
. ;--- Add registry-specific and/or investigational drugs
. Q:RXALL
. S REGIEN=+$$PARAM^RORTSK01("REGIEN"),TMP="AR"
. S:$G(RXOPTS("INVESTIG")) TMP=TMP_"C"
. S:$G(RXOPTS("REGMEDS")) TMP=TMP_"DG"
. S RC=$$DRUGLIST^RORUTL16(ROR8LST,REGIEN,TMP)
;
;=== Process the list of drugs (if present)
I 'RXALL D:$D(RORTSK("PARAMS","DRUGS","G"))>1
. N GRPNAME,GRPTAG,IG,NODE
. I LTAG'>0 D Q:LTAG'>0
. . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,PARTAG)
. ;---
. S NODE=$NA(RORTSK("PARAMS","DRUGS","G"))
. S GRPNAME="",RC=0
. F S GRPNAME=$O(@NODE@(GRPNAME)) Q:GRPNAME="" D Q:RC<0
. . S IG=$O(GRPLST("C",""),-1)+1
. . S GRPLST("C",IG)=GRPNAME,GRPLST("N",GRPNAME)=IG
. . S GRPTAG=$$DRUGLST1(LTAG,GRPNAME,IG)
. . I GRPTAG'>0 S RC=GRPTAG Q
. . ;--- Individual Formulations
. . S RC=$$DRUGLSTF(GRPTAG,GRPNAME,IG) Q:RC<0
. . ;--- Generic Names
. . S RC=$$DRUGLSTG(GRPTAG,GRPNAME,IG) Q:RC<0
. . ;--- Drug Classes
. . S RC=$$DRUGLSTC(GRPTAG,GRPNAME,IG) Q:RC<0
;
;===
Q $S(RC<0:RC,1:LTAG)
;
;***** PROCESS THE GROUP ATTRIBUTES
;
; PTAG Reference (IEN) to the parent tag
; GRPNAME Group Name
; GRPCODE Group Code (sequential number)
;
; Return Values:
; <0 Error code
; >0 IEN of the GROUP element
;
DRUGLST1(PTAG,GRPNAME,GRPCODE) ;
N GRPOPTS,GRPTAG,RC,TMP
;--- Create the group tag
S GRPTAG=$$ADDVAL^RORTSK11(RORTSK,"GROUP",,PTAG)
Q:GRPTAG'>0 GRPTAG
D ADDATTR^RORTSK11(RORTSK,GRPTAG,"NAME",GRPNAME)
;--- Process the group attributes
M GRPOPTS=RORTSK("PARAMS","DRUGS","G",GRPNAME,"A")
I $D(GRPOPTS)>1 S RC=0 D Q:RC<0 RC
. N ATTR,REGIEN S ATTR=""
. F S ATTR=$O(GRPOPTS(ATTR)) Q:ATTR="" D Q:RC<0
. . S RC=$$ADDATTR^RORTSK11(RORTSK,GRPTAG,ATTR,"1")
. Q:RC<0
. S TMP=$$OPTXT^RORXU002(.GRPOPTS)
. D:TMP'="" ADDATTR^RORTSK11(RORTSK,GRPTAG,"DESCR",TMP)
. ;--- Add registry-specific and/or investigational drugs
. S REGIEN=+$$PARAM^RORTSK01("REGIEN"),TMP="AR"
. S:$G(GRPOPTS("INVESTIG")) TMP=TMP_"C"
. S:$G(GRPOPTS("REGMEDS")) TMP=TMP_"DG"
. S RC=$$DRUGLIST^RORUTL16(ROR8LST,REGIEN,TMP,GRPCODE)
;---
Q GRPTAG
;
;***** PROCESS DRUG CLASSES
;
; PTAG Reference (IEN) to the parent tag
; GRPNAME Group Name
; GRPCODE Group Code (sequential number)
;
; Return Values:
; <0 Error code
; >0 IEN of the VARXCLS element
;
DRUGLSTC(PTAG,GRPNAME,GRPCODE) ;
N CODE,IEN,LTAG,NODE,RORTMP,SUBS
S NODE=$NA(RORTSK("PARAMS","DRUGS","G",GRPNAME,"VARXCLS"))
Q:$D(@NODE)<10 0
S LTAG=$$ADDVAL^RORTSK11(RORTSK,"VARXCLS",,PTAG)
Q:LTAG<0 LTAG
;---
S RORTMP=$$ALLOC^RORTMP(.SUBS)
S IEN=0
F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
. D IEN^PSN50P65(IEN,,SUBS)
. S CODE=$G(@RORTMP@(IEN,.01)) Q:CODE=""
. D ADDVAL^RORTSK11(RORTSK,"VARXCL",CODE,LTAG,,IEN)
. D RXADDVCL^RORUTL16(ROR8LST,IEN,1,GRPCODE)
D FREE^RORTMP(RORTMP)
;---
Q LTAG
;
;***** PROCESS INDIVIDUAL FORMULATIONS
;
; PTAG Reference (IEN) to the parent tag
; GRPNAME Group Name
; GRPCODE Group Code (sequential number)
;
; Return Values:
; <0 Error code
; >0 IEN of the FORMULATIONS element
;
DRUGLSTF(PTAG,GRPNAME,GRPCODE) ;
N IEN,LTAG,NAME,NODE,RORTMP,SUBS
S NODE=$NA(RORTSK("PARAMS","DRUGS","G",GRPNAME,"FORMULATIONS"))
Q:$D(@NODE)<10 0
S LTAG=$$ADDVAL^RORTSK11(RORTSK,"FORMULATIONS",,PTAG)
Q:LTAG<0 LTAG
;---
S RORTMP=$$ALLOC^RORTMP(.SUBS)
S IEN=0
F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
. D ZERO^PSS50(IEN,,,,,SUBS)
. S NAME=$G(@RORTMP@(IEN,.01)) Q:NAME=""
. D ADDVAL^RORTSK11(RORTSK,"DRUG",NAME,LTAG,,IEN)
. S @ROR8LST@(IEN,GRPCODE)=""
D FREE^RORTMP(RORTMP)
;---
Q LTAG
;
;***** PROCESS GENERIC NAMES
;
; PTAG Reference (IEN) to the parent tag
; GRPNAME Group Name
; GRPCODE Group Code (sequential number)
;
; Return Values:
; <0 Error code
; >0 IEN of the GENERIC element
;
DRUGLSTG(PTAG,GRPNAME,GRPCODE) ;
N IEN,LTAG,NAME,NODE,RORTMP,SUBS
S NODE=$NA(RORTSK("PARAMS","DRUGS","G",GRPNAME,"GENERIC"))
Q:$D(@NODE)<10 0
S LTAG=$$ADDVAL^RORTSK11(RORTSK,"GENERIC",,PTAG)
Q:LTAG<0 LTAG
;---
S RORTMP=$$ALLOC^RORTMP(.SUBS)
S IEN=0
F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
. D ZERO^PSN50P6(IEN,,,,SUBS)
. S NAME=$G(@RORTMP@(IEN,.01)) Q:NAME=""
. D ADDVAL^RORTSK11(RORTSK,"DRUG",NAME,LTAG,,IEN)
. D RXADDGEN^RORUTL16(ROR8LST,IEN,1,GRPCODE)
D FREE^RORTMP(RORTMP)
;---
Q LTAG
;
;***** FUNCTION FOR THE PHARMACY SEARCH API
;
; .RORDST Reference to the search descriptor
; DRUGIEN IEN of an individual formulation (dispensed drug)
; ROR8LST Closed root of the drug list generated by the
; $$DRUGLST^RORXU007 function or "*" for all drugs.
;
; Return Values:
; 0 Ok
; 1 Skip the record
;
RXGRPCHK(RORDST,DRUGIEN,ROR8LST) ;
Q:ROR8LST="*" 0
Q:$D(@ROR8LST@(DRUGIEN))<10 1
N GRP S GRP=""
F S GRP=$O(@ROR8LST@(DRUGIEN,GRP)) Q:GRP="" D
. K RORDST("RORXGRP",GRP)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORXU007 7929 printed Sep 23, 2025@19:21:09 Page 2
RORXU007 ;HCIOFO/SG - PHARMACY-RELATED REPORT PARAMETERS ; 11/25/05 6:00pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #4533 ZERO^PSS50 (supported)
+6 ; #4540 ZERO^PSN50P6 (supported)
+7 ; #4543 IEN^PSN50P65 (supported)
+8 ;
+9 QUIT
+10 ;
+11 ;***** PROCESSES THE "DRUGS" REPORT PARAMETER
+12 ;
+13 ; .RORTSK Task number and task parameters
+14 ;
+15 ; PARTAG Reference (IEN) to the parent tag
+16 ;
+17 ; .ROR8LST Reference to a local variable, which contains a
+18 ; closed root of an array. IEN's of dispensed drugs
+19 ; will be returned into this array.
+20 ;
+21 ; @ROR8LTST@(DrugIEN,Group#) = ""
+22 ;
+23 ; If this parameter is undefined or empty, then a
+24 ; temporary buffer is allocated by the $$ALLOC^RORTMP
+25 ; function and its root is returned via this parameter.
+26 ;
+27 ; If all drugs are requested (the "ALL" attribute of
+28 ; the "DRUGS" tag), then "*" is returned.
+29 ;
+30 ; [.GRPLST] Reference to a local variable that will contain
+31 ; the list of drug groups.
+32 ;
+33 ; GRPLST(
+34 ; "C",Group#) = GroupName
+35 ; "N",GroupName) = Group#
+36 ;
+37 ; Return Values:
+38 ; <0 Error code
+39 ; >0 IEN of the DRUGS element
+40 ;
DRUGLST(RORTSK,PARTAG,ROR8LST,GRPLST) ;
+1 NEW LTAG,RC,RXALL,RXOPTS,TMP
+2 SET RXALL=+$$PARAM^RORTSK01("DRUGS","ALL")
+3 SET (LTAG,RC)=0
+4 ;
+5 ;=== Validate parameters
+6 IF RXALL
Begin DoDot:1
+7 FOR TMP="INVESTIG","REGMDES"
KILL RORTSK("PARAMS","DRUGS","A",TMP)
End DoDot:1
SET ROR8LST="*"
+8 IF '$TEST
Begin DoDot:1
+9 if $GET(ROR8LST)=""
SET ROR8LST=$$ALLOC^RORTMP()
+10 ;--- Aggregate by individual formulations if investigational
+11 ;--- medications are selected (they are not linked to generics)
+12 if $$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
Begin DoDot:2
+13 NEW GRPNAME,INV,NODE
+14 IF '$$PARAM^RORTSK01("DRUGS","INVESTIG")
SET INV=0
Begin DoDot:3
+15 SET NODE=$NAME(RORTSK("PARAMS","DRUGS","G"))
+16 SET GRPNAME=""
+17 FOR
SET GRPNAME=$ORDER(@NODE@(GRPNAME))
if GRPNAME=""
QUIT
Begin DoDot:4
+18 if $GET(@NODE@(GRPNAME,"A","INVESTIG"))
SET INV=1
End DoDot:4
if INV
QUIT
End DoDot:3
if 'INV
QUIT
+19 KILL RORTSK("PARAMS","DRUGS","A","AGGR_GENERIC")
+20 SET RORTSK("PARAMS","DRUGS","A","AGGR_FORMUL")=1
+21 SET RORTSK("PARAMS","DRUGS","A","AGGR_FORCED")=1
End DoDot:2
End DoDot:1
KILL @ROR8LST
+22 ;
+23 ;=== Process the drug options (if present)
+24 MERGE RXOPTS=RORTSK("PARAMS","DRUGS","A")
+25 IF $DATA(RXOPTS)>1
Begin DoDot:1
+26 NEW ATTR,REGIEN
+27 SET ATTR=$SELECT(RXALL:"ALL",1:"")
+28 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",ATTR,PARTAG)
+29 if LTAG'>0
QUIT
+30 ;--- Output option attributes
+31 SET ATTR=""
SET RC=0
+32 FOR
SET ATTR=$ORDER(RXOPTS(ATTR))
if ATTR=""
QUIT
Begin DoDot:2
+33 SET RC=$$ADDATTR^RORTSK11(RORTSK,LTAG,ATTR,"1")
End DoDot:2
if RC<0
QUIT
+34 IF RC<0
SET LTAG=RC
QUIT
+35 SET ATTR=$$OPTXT^RORXU002(.RXOPTS)
+36 if ATTR'=""
DO ADDATTR^RORTSK11(RORTSK,LTAG,"DESCR",ATTR)
+37 ;--- Add registry-specific and/or investigational drugs
+38 if RXALL
QUIT
+39 SET REGIEN=+$$PARAM^RORTSK01("REGIEN")
SET TMP="AR"
+40 if $GET(RXOPTS("INVESTIG"))
SET TMP=TMP_"C"
+41 if $GET(RXOPTS("REGMEDS"))
SET TMP=TMP_"DG"
+42 SET RC=$$DRUGLIST^RORUTL16(ROR8LST,REGIEN,TMP)
End DoDot:1
if LTAG'>0
QUIT LTAG
+43 ;
+44 ;=== Process the list of drugs (if present)
+45 IF 'RXALL
if $DATA(RORTSK("PARAMS","DRUGS","G"))>1
Begin DoDot:1
+46 NEW GRPNAME,GRPTAG,IG,NODE
+47 IF LTAG'>0
Begin DoDot:2
+48 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,PARTAG)
End DoDot:2
if LTAG'>0
QUIT
+49 ;---
+50 SET NODE=$NAME(RORTSK("PARAMS","DRUGS","G"))
+51 SET GRPNAME=""
SET RC=0
+52 FOR
SET GRPNAME=$ORDER(@NODE@(GRPNAME))
if GRPNAME=""
QUIT
Begin DoDot:2
+53 SET IG=$ORDER(GRPLST("C",""),-1)+1
+54 SET GRPLST("C",IG)=GRPNAME
SET GRPLST("N",GRPNAME)=IG
+55 SET GRPTAG=$$DRUGLST1(LTAG,GRPNAME,IG)
+56 IF GRPTAG'>0
SET RC=GRPTAG
QUIT
+57 ;--- Individual Formulations
+58 SET RC=$$DRUGLSTF(GRPTAG,GRPNAME,IG)
if RC<0
QUIT
+59 ;--- Generic Names
+60 SET RC=$$DRUGLSTG(GRPTAG,GRPNAME,IG)
if RC<0
QUIT
+61 ;--- Drug Classes
+62 SET RC=$$DRUGLSTC(GRPTAG,GRPNAME,IG)
if RC<0
QUIT
End DoDot:2
if RC<0
QUIT
End DoDot:1
+63 ;
+64 ;===
+65 QUIT $SELECT(RC<0:RC,1:LTAG)
+66 ;
+67 ;***** PROCESS THE GROUP ATTRIBUTES
+68 ;
+69 ; PTAG Reference (IEN) to the parent tag
+70 ; GRPNAME Group Name
+71 ; GRPCODE Group Code (sequential number)
+72 ;
+73 ; Return Values:
+74 ; <0 Error code
+75 ; >0 IEN of the GROUP element
+76 ;
DRUGLST1(PTAG,GRPNAME,GRPCODE) ;
+1 NEW GRPOPTS,GRPTAG,RC,TMP
+2 ;--- Create the group tag
+3 SET GRPTAG=$$ADDVAL^RORTSK11(RORTSK,"GROUP",,PTAG)
+4 if GRPTAG'>0
QUIT GRPTAG
+5 DO ADDATTR^RORTSK11(RORTSK,GRPTAG,"NAME",GRPNAME)
+6 ;--- Process the group attributes
+7 MERGE GRPOPTS=RORTSK("PARAMS","DRUGS","G",GRPNAME,"A")
+8 IF $DATA(GRPOPTS)>1
SET RC=0
Begin DoDot:1
+9 NEW ATTR,REGIEN
SET ATTR=""
+10 FOR
SET ATTR=$ORDER(GRPOPTS(ATTR))
if ATTR=""
QUIT
Begin DoDot:2
+11 SET RC=$$ADDATTR^RORTSK11(RORTSK,GRPTAG,ATTR,"1")
End DoDot:2
if RC<0
QUIT
+12 if RC<0
QUIT
+13 SET TMP=$$OPTXT^RORXU002(.GRPOPTS)
+14 if TMP'=""
DO ADDATTR^RORTSK11(RORTSK,GRPTAG,"DESCR",TMP)
+15 ;--- Add registry-specific and/or investigational drugs
+16 SET REGIEN=+$$PARAM^RORTSK01("REGIEN")
SET TMP="AR"
+17 if $GET(GRPOPTS("INVESTIG"))
SET TMP=TMP_"C"
+18 if $GET(GRPOPTS("REGMEDS"))
SET TMP=TMP_"DG"
+19 SET RC=$$DRUGLIST^RORUTL16(ROR8LST,REGIEN,TMP,GRPCODE)
End DoDot:1
if RC<0
QUIT RC
+20 ;---
+21 QUIT GRPTAG
+22 ;
+23 ;***** PROCESS DRUG CLASSES
+24 ;
+25 ; PTAG Reference (IEN) to the parent tag
+26 ; GRPNAME Group Name
+27 ; GRPCODE Group Code (sequential number)
+28 ;
+29 ; Return Values:
+30 ; <0 Error code
+31 ; >0 IEN of the VARXCLS element
+32 ;
DRUGLSTC(PTAG,GRPNAME,GRPCODE) ;
+1 NEW CODE,IEN,LTAG,NODE,RORTMP,SUBS
+2 SET NODE=$NAME(RORTSK("PARAMS","DRUGS","G",GRPNAME,"VARXCLS"))
+3 if $DATA(@NODE)<10
QUIT 0
+4 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"VARXCLS",,PTAG)
+5 if LTAG<0
QUIT LTAG
+6 ;---
+7 SET RORTMP=$$ALLOC^RORTMP(.SUBS)
+8 SET IEN=0
+9 FOR
SET IEN=$ORDER(@NODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+10 DO IEN^PSN50P65(IEN,,SUBS)
+11 SET CODE=$GET(@RORTMP@(IEN,.01))
if CODE=""
QUIT
+12 DO ADDVAL^RORTSK11(RORTSK,"VARXCL",CODE,LTAG,,IEN)
+13 DO RXADDVCL^RORUTL16(ROR8LST,IEN,1,GRPCODE)
End DoDot:1
+14 DO FREE^RORTMP(RORTMP)
+15 ;---
+16 QUIT LTAG
+17 ;
+18 ;***** PROCESS INDIVIDUAL FORMULATIONS
+19 ;
+20 ; PTAG Reference (IEN) to the parent tag
+21 ; GRPNAME Group Name
+22 ; GRPCODE Group Code (sequential number)
+23 ;
+24 ; Return Values:
+25 ; <0 Error code
+26 ; >0 IEN of the FORMULATIONS element
+27 ;
DRUGLSTF(PTAG,GRPNAME,GRPCODE) ;
+1 NEW IEN,LTAG,NAME,NODE,RORTMP,SUBS
+2 SET NODE=$NAME(RORTSK("PARAMS","DRUGS","G",GRPNAME,"FORMULATIONS"))
+3 if $DATA(@NODE)<10
QUIT 0
+4 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"FORMULATIONS",,PTAG)
+5 if LTAG<0
QUIT LTAG
+6 ;---
+7 SET RORTMP=$$ALLOC^RORTMP(.SUBS)
+8 SET IEN=0
+9 FOR
SET IEN=$ORDER(@NODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+10 DO ZERO^PSS50(IEN,,,,,SUBS)
+11 SET NAME=$GET(@RORTMP@(IEN,.01))
if NAME=""
QUIT
+12 DO ADDVAL^RORTSK11(RORTSK,"DRUG",NAME,LTAG,,IEN)
+13 SET @ROR8LST@(IEN,GRPCODE)=""
End DoDot:1
+14 DO FREE^RORTMP(RORTMP)
+15 ;---
+16 QUIT LTAG
+17 ;
+18 ;***** PROCESS GENERIC NAMES
+19 ;
+20 ; PTAG Reference (IEN) to the parent tag
+21 ; GRPNAME Group Name
+22 ; GRPCODE Group Code (sequential number)
+23 ;
+24 ; Return Values:
+25 ; <0 Error code
+26 ; >0 IEN of the GENERIC element
+27 ;
DRUGLSTG(PTAG,GRPNAME,GRPCODE) ;
+1 NEW IEN,LTAG,NAME,NODE,RORTMP,SUBS
+2 SET NODE=$NAME(RORTSK("PARAMS","DRUGS","G",GRPNAME,"GENERIC"))
+3 if $DATA(@NODE)<10
QUIT 0
+4 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"GENERIC",,PTAG)
+5 if LTAG<0
QUIT LTAG
+6 ;---
+7 SET RORTMP=$$ALLOC^RORTMP(.SUBS)
+8 SET IEN=0
+9 FOR
SET IEN=$ORDER(@NODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+10 DO ZERO^PSN50P6(IEN,,,,SUBS)
+11 SET NAME=$GET(@RORTMP@(IEN,.01))
if NAME=""
QUIT
+12 DO ADDVAL^RORTSK11(RORTSK,"DRUG",NAME,LTAG,,IEN)
+13 DO RXADDGEN^RORUTL16(ROR8LST,IEN,1,GRPCODE)
End DoDot:1
+14 DO FREE^RORTMP(RORTMP)
+15 ;---
+16 QUIT LTAG
+17 ;
+18 ;***** FUNCTION FOR THE PHARMACY SEARCH API
+19 ;
+20 ; .RORDST Reference to the search descriptor
+21 ; DRUGIEN IEN of an individual formulation (dispensed drug)
+22 ; ROR8LST Closed root of the drug list generated by the
+23 ; $$DRUGLST^RORXU007 function or "*" for all drugs.
+24 ;
+25 ; Return Values:
+26 ; 0 Ok
+27 ; 1 Skip the record
+28 ;
RXGRPCHK(RORDST,DRUGIEN,ROR8LST) ;
+1 if ROR8LST="*"
QUIT 0
+2 if $DATA(@ROR8LST@(DRUGIEN))<10
QUIT 1
+3 NEW GRP
SET GRP=""
+4 FOR
SET GRP=$ORDER(@ROR8LST@(DRUGIEN,GRP))
if GRP=""
QUIT
Begin DoDot:1
+5 KILL RORDST("RORXGRP",GRP)
End DoDot:1
+6 QUIT 0
