RORUTL16 ;HCIOFO/SG - PHARMACY DATA SEARCH (UTILITIES) ; 10/6/05 9:34am
;;1.5;CLINICAL CASE REGISTRIES;**32**;Feb 17, 2006;Build 20
;
; This routine uses the following IAs:
;
; #4533 AND^PSS50, VAC^PSS50 (supported)
; #4543 IEN^PSN50P65 (supported)
;
Q
;
;***** LOADS THE LIST OF REGISTRY SPECIFIC DRUGS
;
; ROR8DST Closed root of the destination buffer
;
; REGIEN Registry IEN
;
; [FLAGS] Flags to control processing:
; A Do not kill the destination array before
; loading the drugs (Add the drugs)
; C Include VA drug classes from the file #798.6
; D Include local (dispensed) drugs from the LOCAL
; DRUG NAME multiple of the file #798.1
; G Include generic drugs from the file #799.51
; R Reduce everything to local (dispensed) drugs
;
; If this parameter has no value ($G(FLAGS)="") then
; the default set of flags is used: "DGR".
;
; [GROUPID] Optional identifier of the drug group. By default
; ($G(GROUPID)=""), 0 is used.
;
; Return Values:
; <0 Error code
; 0 Ok
;
; The list of drugs is returned as follow:
;
; @ROR8DST@(
; DrugIEN,
; GroupID) ""
; "C",
; VAClassIEN,
; GroupID) ""
; "G",
; GenericDrugIEN,
; GroupID) ""
;
; DrugIEN is an internal entry number of the local drug record
; in the DRUG file (#50).
;
; Nodes "C" and/or "G" are created only if the R flag is not used.
; Otherwise, VA drug classes and generic drugs are reduced to the
; local (dispensed) drugs.
;
DRUGLIST(ROR8DST,REGIEN,FLAGS,GROUPID) ;
N DRUGIEN,IEN,NDFP,RC,REDUCE,ROOT,RORMSG,VACLIEN
S FLAGS=$S($G(FLAGS)'="":FLAGS,1:"DGR")
S GROUPID=$S($G(GROUPID)'="":GROUPID,1:0)
S REDUCE=(FLAGS["R") K:FLAGS'["A" @ROR8DST
;
;--- Drug classes
D:FLAGS["C"
. S IEN=0
. F S IEN=$O(^ROR(798.6,"AC",REGIEN,IEN)) Q:IEN'>0 D
. . D RXADDVCL(ROR8DST,+$G(^ROR(798.6,IEN,0)),REDUCE,GROUPID)
;
;--- Local drug names
D:FLAGS["D"
. S ROOT=$$ROOT^DILFD(798.129,","_REGIEN_",",1)
. S IEN=0
. F S IEN=$O(@ROOT@(IEN)) Q:IEN'>0 D
. . S DRUGIEN=+$P($G(@ROOT@(IEN,0)),U)
. . S:DRUGIEN>0 @ROR8DST@(DRUGIEN,GROUPID)=""
;
;--- Generic drugs
D:FLAGS["G"
. N RGS S RGS=REGIEN_"#",DRUGIEN=0
. F S DRUGIEN=$O(^ROR(799.51,"ARDG",RGS,DRUGIEN)) Q:DRUGIEN'>0 D
. . D RXADDGEN(ROR8DST,DRUGIEN,REDUCE,GROUPID)
Q 0
;
;***** LOADS PHARMACY ORDER DATA
;
; .ROR8DST Reference to the ROR8DST parameter
; passed into the callback function.
;
; ORDFLGS Flags describing the original order
;
; Return Values:
; <0 Error code
; 0 Ok
; 1 Skip this refill
;
ORDER(ROR8DST,ORDFLGS) ;
N DATE,FILLTYPE
D:ORDFLGS["I"
. S DATE=$P(RORRXE(0),U,5),FILLTYPE="I"
D:ORDFLGS["O"
. S DATE=$P(RORRXE("RXN",0),U,6)
. S FILLTYPE=$P(RORRXE("RXN",0),U,3)
Q
;
;***** ADDS THE GENERIC DRUG TO THE LIST OF DRUGS
;
; ROR8DST Closed root of the destination buffer
;
; GENIEN IEN of a generic drug
;
; [REDUCE] Reduce the class to a list of local drugs
;
; [GROUPID] Drug group ID
;
RXADDGEN(ROR8DST,GENIEN,REDUCE,GROUPID) ;
Q:GENIEN'>0
S GROUPID=$S($G(GROUPID)'="":GROUPID,1:0)
I '$G(REDUCE) S @ROR8DST@("G",GENIEN,GROUPID)="" Q
N DRUGIEN,RORTMP,RORTS
S RORTMP=$$ALLOC^RORTMP(.RORTS)
D AND^PSS50(GENIEN,,,RORTS)
S DRUGIEN=0
F S DRUGIEN=$O(@RORTMP@(DRUGIEN)) Q:DRUGIEN'>0 D
. S @ROR8DST@(DRUGIEN,GROUPID)=""
D XDRG^RORUTL22(GENIEN,GROUPID)
D FREE^RORTMP(RORTMP)
Q
;
;***** ADDS THE VA DRUG CLASS TO THE LIST OF DRUGS
;
; ROR8DST Closed root of the destination buffer
;
; VACL Either IEN or code of a VA drug class
;
; [REDUCE] Reduce the class to a list of local drugs
;
; [GROUPID] Drug group ID
;
; [FLAGS] Flags to control processing:
; E Always treat content of the VACL parameter as
; a code of the VA Drug Class (instead of IEN)
;
RXADDVCL(ROR8DST,VACL,REDUCE,GROUPID,FLAGS) ;
N DRUGIEN,RORMSG,RORTMP,RORTS,TMP,VACLIEN
S RORTMP=$$ALLOC^RORTMP(.RORTS)
D
. S VACLIEN=+VACL
. I (VACLIEN'=VACL)!($G(FLAGS)["E") D
. . D IEN^PSN50P65(,VACL,RORTS)
. . S TMP=+$G(@RORTMP@(0))
. . S VACLIEN=$S(TMP=1:+$O(@RORTMP@(0)),1:0)
. Q:VACLIEN'>0
. ;---
. S GROUPID=$S($G(GROUPID)'="":GROUPID,1:0)
. I '$G(REDUCE) S @ROR8DST@("C",VACLIEN,GROUPID)="" Q
. D VAC^PSS50(VACLIEN,,,RORTS)
. S DRUGIEN=0
. F S DRUGIEN=$O(@RORTMP@(DRUGIEN)) Q:DRUGIEN'>0 D
. . S @ROR8DST@(DRUGIEN,GROUPID)=""
;
D FREE^RORTMP(RORTMP)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUTL16 4851 printed Sep 23, 2025@19:20:07 Page 2
RORUTL16 ;HCIOFO/SG - PHARMACY DATA SEARCH (UTILITIES) ; 10/6/05 9:34am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**32**;Feb 17, 2006;Build 20
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #4533 AND^PSS50, VAC^PSS50 (supported)
+6 ; #4543 IEN^PSN50P65 (supported)
+7 ;
+8 QUIT
+9 ;
+10 ;***** LOADS THE LIST OF REGISTRY SPECIFIC DRUGS
+11 ;
+12 ; ROR8DST Closed root of the destination buffer
+13 ;
+14 ; REGIEN Registry IEN
+15 ;
+16 ; [FLAGS] Flags to control processing:
+17 ; A Do not kill the destination array before
+18 ; loading the drugs (Add the drugs)
+19 ; C Include VA drug classes from the file #798.6
+20 ; D Include local (dispensed) drugs from the LOCAL
+21 ; DRUG NAME multiple of the file #798.1
+22 ; G Include generic drugs from the file #799.51
+23 ; R Reduce everything to local (dispensed) drugs
+24 ;
+25 ; If this parameter has no value ($G(FLAGS)="") then
+26 ; the default set of flags is used: "DGR".
+27 ;
+28 ; [GROUPID] Optional identifier of the drug group. By default
+29 ; ($G(GROUPID)=""), 0 is used.
+30 ;
+31 ; Return Values:
+32 ; <0 Error code
+33 ; 0 Ok
+34 ;
+35 ; The list of drugs is returned as follow:
+36 ;
+37 ; @ROR8DST@(
+38 ; DrugIEN,
+39 ; GroupID) ""
+40 ; "C",
+41 ; VAClassIEN,
+42 ; GroupID) ""
+43 ; "G",
+44 ; GenericDrugIEN,
+45 ; GroupID) ""
+46 ;
+47 ; DrugIEN is an internal entry number of the local drug record
+48 ; in the DRUG file (#50).
+49 ;
+50 ; Nodes "C" and/or "G" are created only if the R flag is not used.
+51 ; Otherwise, VA drug classes and generic drugs are reduced to the
+52 ; local (dispensed) drugs.
+53 ;
DRUGLIST(ROR8DST,REGIEN,FLAGS,GROUPID) ;
+1 NEW DRUGIEN,IEN,NDFP,RC,REDUCE,ROOT,RORMSG,VACLIEN
+2 SET FLAGS=$SELECT($GET(FLAGS)'="":FLAGS,1:"DGR")
+3 SET GROUPID=$SELECT($GET(GROUPID)'="":GROUPID,1:0)
+4 SET REDUCE=(FLAGS["R")
if FLAGS'["A"
KILL @ROR8DST
+5 ;
+6 ;--- Drug classes
+7 if FLAGS["C"
Begin DoDot:1
+8 SET IEN=0
+9 FOR
SET IEN=$ORDER(^ROR(798.6,"AC",REGIEN,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+10 DO RXADDVCL(ROR8DST,+$GET(^ROR(798.6,IEN,0)),REDUCE,GROUPID)
End DoDot:2
End DoDot:1
+11 ;
+12 ;--- Local drug names
+13 if FLAGS["D"
Begin DoDot:1
+14 SET ROOT=$$ROOT^DILFD(798.129,","_REGIEN_",",1)
+15 SET IEN=0
+16 FOR
SET IEN=$ORDER(@ROOT@(IEN))
if IEN'>0
QUIT
Begin DoDot:2
+17 SET DRUGIEN=+$PIECE($GET(@ROOT@(IEN,0)),U)
+18 if DRUGIEN>0
SET @ROR8DST@(DRUGIEN,GROUPID)=""
End DoDot:2
End DoDot:1
+19 ;
+20 ;--- Generic drugs
+21 if FLAGS["G"
Begin DoDot:1
+22 NEW RGS
SET RGS=REGIEN_"#"
SET DRUGIEN=0
+23 FOR
SET DRUGIEN=$ORDER(^ROR(799.51,"ARDG",RGS,DRUGIEN))
if DRUGIEN'>0
QUIT
Begin DoDot:2
+24 DO RXADDGEN(ROR8DST,DRUGIEN,REDUCE,GROUPID)
End DoDot:2
End DoDot:1
+25 QUIT 0
+26 ;
+27 ;***** LOADS PHARMACY ORDER DATA
+28 ;
+29 ; .ROR8DST Reference to the ROR8DST parameter
+30 ; passed into the callback function.
+31 ;
+32 ; ORDFLGS Flags describing the original order
+33 ;
+34 ; Return Values:
+35 ; <0 Error code
+36 ; 0 Ok
+37 ; 1 Skip this refill
+38 ;
ORDER(ROR8DST,ORDFLGS) ;
+1 NEW DATE,FILLTYPE
+2 if ORDFLGS["I"
Begin DoDot:1
+3 SET DATE=$PIECE(RORRXE(0),U,5)
SET FILLTYPE="I"
End DoDot:1
+4 if ORDFLGS["O"
Begin DoDot:1
+5 SET DATE=$PIECE(RORRXE("RXN",0),U,6)
+6 SET FILLTYPE=$PIECE(RORRXE("RXN",0),U,3)
End DoDot:1
+7 QUIT
+8 ;
+9 ;***** ADDS THE GENERIC DRUG TO THE LIST OF DRUGS
+10 ;
+11 ; ROR8DST Closed root of the destination buffer
+12 ;
+13 ; GENIEN IEN of a generic drug
+14 ;
+15 ; [REDUCE] Reduce the class to a list of local drugs
+16 ;
+17 ; [GROUPID] Drug group ID
+18 ;
RXADDGEN(ROR8DST,GENIEN,REDUCE,GROUPID) ;
+1 if GENIEN'>0
QUIT
+2 SET GROUPID=$SELECT($GET(GROUPID)'="":GROUPID,1:0)
+3 IF '$GET(REDUCE)
SET @ROR8DST@("G",GENIEN,GROUPID)=""
QUIT
+4 NEW DRUGIEN,RORTMP,RORTS
+5 SET RORTMP=$$ALLOC^RORTMP(.RORTS)
+6 DO AND^PSS50(GENIEN,,,RORTS)
+7 SET DRUGIEN=0
+8 FOR
SET DRUGIEN=$ORDER(@RORTMP@(DRUGIEN))
if DRUGIEN'>0
QUIT
Begin DoDot:1
+9 SET @ROR8DST@(DRUGIEN,GROUPID)=""
End DoDot:1
+10 DO XDRG^RORUTL22(GENIEN,GROUPID)
+11 DO FREE^RORTMP(RORTMP)
+12 QUIT
+13 ;
+14 ;***** ADDS THE VA DRUG CLASS TO THE LIST OF DRUGS
+15 ;
+16 ; ROR8DST Closed root of the destination buffer
+17 ;
+18 ; VACL Either IEN or code of a VA drug class
+19 ;
+20 ; [REDUCE] Reduce the class to a list of local drugs
+21 ;
+22 ; [GROUPID] Drug group ID
+23 ;
+24 ; [FLAGS] Flags to control processing:
+25 ; E Always treat content of the VACL parameter as
+26 ; a code of the VA Drug Class (instead of IEN)
+27 ;
RXADDVCL(ROR8DST,VACL,REDUCE,GROUPID,FLAGS) ;
+1 NEW DRUGIEN,RORMSG,RORTMP,RORTS,TMP,VACLIEN
+2 SET RORTMP=$$ALLOC^RORTMP(.RORTS)
+3 Begin DoDot:1
+4 SET VACLIEN=+VACL
+5 IF (VACLIEN'=VACL)!($GET(FLAGS)["E")
Begin DoDot:2
+6 DO IEN^PSN50P65(,VACL,RORTS)
+7 SET TMP=+$GET(@RORTMP@(0))
+8 SET VACLIEN=$SELECT(TMP=1:+$ORDER(@RORTMP@(0)),1:0)
End DoDot:2
+9 if VACLIEN'>0
QUIT
+10 ;---
+11 SET GROUPID=$SELECT($GET(GROUPID)'="":GROUPID,1:0)
+12 IF '$GET(REDUCE)
SET @ROR8DST@("C",VACLIEN,GROUPID)=""
QUIT
+13 DO VAC^PSS50(VACLIEN,,,RORTS)
+14 SET DRUGIEN=0
+15 FOR
SET DRUGIEN=$ORDER(@RORTMP@(DRUGIEN))
if DRUGIEN'>0
QUIT
Begin DoDot:2
+16 SET @ROR8DST@(DRUGIEN,GROUPID)=""
End DoDot:2
End DoDot:1
+17 ;
+18 DO FREE^RORTMP(RORTMP)
+19 QUIT
