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

RORRP017.m

Go to the documentation of this file.
  1. RORRP017 ;HIOFO/SG,VC - RPC: DRUGS AND CLASSES ;4/17/09 10:45am
  1. ;;1.5;CLINICAL CASE REGISTRIES;**8**;Feb 17, 2006;Build 8
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #4533 ZERO^PSS50, NDF^PSS50, DATA^PSS50 (supported)
  1. ; #4540 ZERO^PSN50P6 (supported)
  1. ; #4543 C^PSN50P65, IEN^PSN50P65 (supported)
  1. ;
  1. ; This routine was modified March 2009 to include Registry Drugs
  1. ; RPC call is ROR LIST REGISTRY DRUGS into tag RORGEN
  1. ;
  1. Q
  1. ;
  1. ;***** RETURNS THE LIST OF DRUGS (DISPENSED OR GENERIC)
  1. ; RPC: [ROR LIST DRUGS]
  1. ;
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; [PART] The partial match restriction.
  1. ;
  1. ; [FLAGS] Flags that control the execution (can be combined):
  1. ; G Retrive generic drugs (from file #50.6).
  1. ; Otherwise, list of dispensed drugs (from
  1. ; file #50) is retrieved.
  1. ;
  1. ; [NUMBER] Deprecated
  1. ; [FROM] Deprecated
  1. ;
  1. ; Return Values:
  1. ;
  1. ; A negative value of the first "^"-piece of the RESULTS(0)
  1. ; indicates an error (see the RPCSTK^RORERR procedure for more
  1. ; details).
  1. ;
  1. ; Otherwise, number of drugs is returned in the
  1. ; @RESULTS@(0) and the subsequent nodes of the global array
  1. ; contain the drugs.
  1. ;
  1. ; @RESULTS@(0) Number of drugs
  1. ;
  1. ; @RESULTS@(i) Drug
  1. ; ^01: Drug IEN
  1. ; ^02: Drug Name
  1. ; ^03: VA Drug Class (only for dispensed)
  1. ;
  1. DRUGLIST(RESULTS,PART,FLAGS,NUMBER,FROM) ;
  1. N BUF,CNT,GENERIC,IEN,LP,NAME,NODE,RC,RORERRDL,TMP
  1. D CLEAR^RORERR("DRUGLIST^RORRP017",1)
  1. K RESULTS S RESULTS=$$ALLOC^RORTMP()
  1. ;--- Check the parameters
  1. S FLAGS=$G(FLAGS) S:$G(PART)="" PART="??"
  1. S GENERIC=(FLAGS["G")
  1. ;--- Get the list of drugs
  1. S NODE=$$ALLOC^RORTMP(.TMP)
  1. I GENERIC D
  1. . D ZERO^PSN50P6(,PART,,,TMP) ; Generic
  1. E D ZERO^PSS50(,PART,,,,TMP) ; Dispensed
  1. ;--- Copy the data to the destination array
  1. S:PART="??" PART="" S LP=$L(PART)
  1. S NAME="",CNT=0
  1. F S NAME=$O(@NODE@("B",NAME)) Q:NAME="" D
  1. . S IEN=""
  1. . F S IEN=$O(@NODE@("B",NAME,IEN)) Q:IEN="" D
  1. . . S TMP=$G(@NODE@(IEN,.01)) Q:TMP=""
  1. . . Q:$E(TMP,1,LP)'=PART ; Exclude mnemonics
  1. . . S BUF=IEN_U_TMP S:'GENERIC $P(BUF,U,3)=$G(@NODE@(IEN,2))
  1. . . S CNT=CNT+1,@RESULTS@(CNT)=BUF
  1. ;--- Success
  1. S @RESULTS@(0)=CNT
  1. D FREE^RORTMP(NODE)
  1. Q
  1. ;
  1. ;***** RETURNS THE LIST OF VA DRUG CLASSES
  1. ; RPC: [ROR LIST VA DRUG CLASSES]
  1. ;
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; [PARENT] Reserved
  1. ;
  1. ; [PART] The partial match restriction.
  1. ;
  1. ; [FLAGS] Flags that control the execution (can be combined):
  1. ; N Search classes by their names
  1. ; (by default, the search is performed by codes)
  1. ;
  1. ; [NUMBER] Deprecated
  1. ; [FROM] Deprecated
  1. ;
  1. ; Return Values:
  1. ;
  1. ; A negative value of the first "^"-piece of the @RESULTS@(0)
  1. ; indicates an error (see the RPCSTK^RORERR procedure for more
  1. ; details).
  1. ;
  1. ; Otherwise, number of drug classes is returned in the
  1. ; @RESULTS@(0) and the subsequent nodes of the global array
  1. ; contain the classes.
  1. ;
  1. ; @RESULTS@(0) Number of classes
  1. ;
  1. ; @RESULTS@(i) Drug Class
  1. ; ^01: IEN
  1. ; ^02: Classification
  1. ; ^03: Code
  1. ;
  1. VACLSLST(RESULTS,PARENT,PART,FLAGS,NUMBER,FROM) ;
  1. N CNT,IEN,LP,NODE,RC,RORERRDL,SUBS,TMP,VAL,XREF
  1. D CLEAR^RORERR("VACLSLST^RORRP017",1)
  1. K RESULTS S RESULTS=$$ALLOC^RORTMP()
  1. ;--- Check the parameters
  1. S FLAGS=$G(FLAGS) S:$G(PART)="" PART="??"
  1. ;--- Get the list of codes
  1. S NODE=$$ALLOC^RORTMP(.TMP)
  1. I FLAGS["N" D S XREF="C",SUBS=1
  1. . D C^PSN50P65(,PART,TMP)
  1. E D S XREF="B",SUBS=.01
  1. . D IEN^PSN50P65(,PART,TMP)
  1. ;--- Copy the data to the destination array
  1. S:PART="??" PART="" S LP=$L(PART)
  1. S VAL="",CNT=0
  1. F S VAL=$O(@NODE@(XREF,VAL)) Q:VAL="" D
  1. . S IEN=""
  1. . F S IEN=$O(@NODE@(XREF,VAL,IEN)) Q:IEN="" D
  1. . . S TMP=$G(@NODE@(IEN,SUBS))
  1. . . Q:$E(TMP,1,LP)'=PART ; Exclude mnemonics
  1. . . S CNT=CNT+1
  1. . . S @RESULTS@(CNT)=IEN_U_$G(@NODE@(IEN,1))_U_$G(@NODE@(IEN,.01))
  1. ;--- Success
  1. S @RESULTS@(0)=CNT
  1. D FREE^RORTMP(NODE)
  1. Q
  1. ;
  1. ;***** RETURNS THE LIST OF REGISTRY DRUGS
  1. ; RPC: [ROR LIST REGISTRY DRUGS]
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are return to
  1. ; PART The partial match value passed in from Application
  1. ; FLAGS Not used
  1. ; NUMBER Not used
  1. ; FROM Not used
  1. ;
  1. ; Information returned
  1. ; @RESULTS@(0) Number of drugs returned
  1. ; @RESULTS@(n) Drug Class
  1. ; $p1= IEN
  1. ; $p2= NAME OF DRUG
  1. ;
  1. RORGEN(RESULTS,PART,FLAGS,NUMBER,FROM) ;
  1. N BUF,CNT,GENERIC,IEN,LP,NAME,RC,RORERRDL,TMP,REGID,RRIEN
  1. D CLEAR^RORERR("RORGEN^RORRP017",1)
  1. K RESULTS S RESULTS=$$ALLOC^RORTMP()
  1. S:$G(PART)="" PART="??"
  1. S:PART="??" PART=""
  1. S LP=$L(PART)
  1. S NAME=PART,CNT=0
  1. F S NAME=$O(^ROR(799.51,"B",NAME)) Q:NAME="" D
  1. . Q:$E(NAME,1,LP)'=PART
  1. .S IEN=""
  1. .F S IEN=$O(^ROR(799.51,"B",NAME,IEN)) Q:IEN="" D
  1. . . S REGID=$P($G(^ROR(799.51,IEN,0)),U,2)
  1. . . Q:REGID'=FLAGS
  1. . . S RRIEN=$P($G(^ROR(799.51,IEN,0)),U,4)
  1. . . S BUF=RRIEN_U_NAME,CNT=CNT+1
  1. . . S @RESULTS@(CNT)=BUF
  1. S @RESULTS@(0)=CNT
  1. Q
  1. ;
  1. ;--- Returns a list of Investigative Drugs per registry
  1. ; RPC: [ROR LIST INVESTIGATIVE DRUGS]
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to
  1. ; PART The partial match value passed in from the application
  1. ; FLAGS Indicator of registry HEPC=1, HIV=2
  1. ; NUMBER Not used
  1. ; FROM Not used
  1. RORINV(RESULTS,PART,FLAGS,NUMBER,FROM) ;
  1. N BUF,CNT,IEN,LP,NAME,NODE,RC,RORERRDL,TMP,TMP2,INVES,CLAS,SUBS,PNTR
  1. N RORREG,XREF,VAL
  1. D CLEAR^RORERR("RORINV^RORRP017",1)
  1. K RESULTS
  1. S RESULTS=$$ALLOC^RORTMP()
  1. S NODE=$$ALLOC^RORTMP(.TMP)
  1. S SUBS=$$ALLOC^RORTMP(.TMP2)
  1. S FLAGS=$G(FLAGS)
  1. I FLAGS=1 S RORREG="IN140"
  1. I FLAGS=2 S RORREG="IN150"
  1. S:$G(PART)="" PART="??"
  1. S:PART="??" PART=""
  1. S LP=$L(PART)
  1. ;D B^PSS50(PART,,,,TMP)
  1. D NDF^PSS50(,PART,,,,TMP)
  1. S XREF="B"
  1. S VAL="",CNT=0
  1. F S VAL=$O(@NODE@(XREF,VAL)) Q:VAL="" D
  1. . S IEN=""
  1. . F S IEN=$O(@NODE@(XREF,VAL,IEN)) Q:IEN="" D
  1. . . D DATA^PSS50(IEN,,,,,TMP2)
  1. . . S CLAS=$P($G(@SUBS@(IEN,25)),U,2)
  1. . . Q:CLAS'=RORREG
  1. . . S PNTR=$P($G(@SUBS@(IEN,20)),U,1)
  1. . . S CNT=CNT+1
  1. . . S BUF=PNTR_U_$G(@SUBS@(IEN,.01))
  1. . . S @RESULTS@(CNT)=BUF
  1. S @RESULTS@(0)=CNT
  1. D FREE^RORTMP(NODE)
  1. D FREE^RORTMP(SUBS)
  1. Q
  1. ;