- 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 Jan 18, 2025@02:45:21 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