VistA-FOIAVistA/r/CLINICAL_CASE_REGISTRIES-ROR/RORUTL16.m

160 lines
4.5 KiB
Mathematica

RORUTL16 ;HCIOFO/SG - PHARMACY DATA SEARCH (UTILITIES) ; 10/6/05 9:34am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; 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 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