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

RORRP015.m

Go to the documentation of this file. 
  1. RORRP015 ;HCIOFO/SG - RPC: DIVISIONS AND HOSPITAL LOCATIONS ; 5/25/11 11:49am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**1,15**;Feb 17, 2006;Build 27
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #1246         WIN^DGPMDDCF (supported)
  1.  ; #417          Access to the file #40.8 (controlled)
  1.  ; #10040        Access to the HOSPITAL LOCATION file (supported)
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** CHECKS IF THE HOSPITAL LOCATION IS ACTIVE
  1.  ;
  1.  ; LOCIEN        IEN of the hospital location
  1.  ;
  1. ACTLOC(LOCIEN) ;
  1.  N D0,DGPMOS,RDT,X
  1.  Q:$G(^SC(LOCIEN,"OOS")) 0              ; An OOS entry
  1.  S D0=+$G(^SC(LOCIEN,42))
  1.  I D0>0  D WIN^DGPMDDCF  Q 'X           ; Check if ward is inactive
  1.  S X=$G(^SC(LOCIEN,"I"))  Q:'$P(X,U) 1  ; No inactivation date
  1.  S RDT=+$P(X,U,2)
  1.  I DT>$P(X,U)  Q:'RDT!(DT<RDT) 0        ; Check reactivation date
  1.  Q 1
  1.  ;
  1.  ;***** RETURNS THE LIST OF DIVISIONS
  1.  ; RPC: [ROR LIST DIVISIONS]
  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.  ;                 B  Backwards. Traverses the index in the opposite
  1.  ;                    direction of normal traversal.
  1.  ;
  1.  ; [NUMBER]      Maximum number of entries to return. A value of "*"
  1.  ;               or no value in this parameter designates all entries.
  1.  ;
  1.  ; [FROM]        The index entry(s) from which to begin the list
  1.  ;                 ^01: FromName
  1.  ;                 ^02: FromIEN
  1.  ;
  1.  ;               For example, a FROM value of "VA" would list entries
  1.  ;               following VA. You can use the 2-nd and 3-rd "^"-
  1.  ;               pieces of the @RESULTS@(0) node to continue the
  1.  ;               listing in the subsequent procedure calls.
  1.  ;
  1.  ;               NOTE: The FROM value itself is not included in
  1.  ;                     the resulting list.
  1.  ;
  1.  ; The ^TMP("DILIST",$J) global node is used by the procedure.
  1.  ;
  1.  ; See description of the LIST^DIC for more details about the
  1.  ; PART, NUMBER and FROM parameters.
  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 divisions and the value of the FROM parameter
  1.  ; for the next procedure call are returned in the @RESULTS@(0) and
  1.  ; the subsequent nodes of the global array contain the divisions.
  1.  ; 
  1.  ; @RESULTS@(0)          Result Descriptor
  1.  ;                         ^01: Number of divisions
  1.  ;                         ^02: FromName
  1.  ;                         ^03: FromIEN
  1.  ;
  1.  ; @RESULTS@(i)          Division
  1.  ;                         ^01: IEN
  1.  ;                         ^02: Name
  1.  ;                         ^03: Facility Number
  1.  ;                         ^04: Institution IEN
  1.  ;
  1. DIVLIST(RESULTS,PART,FLAGS,NUMBER,FROM) ;
  1.  N BUF,RC,RORERRDL,RORMSG,TMP,DIERR
  1.  D CLEAR^RORERR("DIVLIST^RORRP015",1)
  1.  K RESULTS  S RESULTS=$NA(^TMP("DILIST",$J))  K @RESULTS
  1.  ;--- Check the parameters
  1.  S PART=$G(PART),FLAGS=$G(FLAGS)
  1.  I PART="??" S PART=""  ;user selects All Divisions
  1.  S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
  1.  ;--- Setup the start point
  1.  I $G(FROM)'=""  D  S FROM=$P(FROM,U)
  1.  . S:$P(FROM,U,2)>0 FROM("IEN")=+$P(FROM,U,2)
  1.  ;--- Get the list of divisions
  1.  S BUF="@;.01;1;.07I",TMP="P"_$S(FLAGS["B":"B",1:"")
  1.  D LIST^DIC(40.8,,BUF,TMP,NUMBER,.FROM,PART,"B",,,,"RORMSG")
  1.  I $G(DIERR)  D  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  . S RC=$$DBS^RORERR("RORMSG",-9,,,40.8)
  1.  . K ^TMP("DILIST",$J)
  1.  ;--- Success
  1.  S TMP=$G(^TMP("DILIST",$J,0)),BUF=+$P(TMP,U)
  1.  K ^TMP("DILIST",$J,0)
  1.  S:$P(TMP,U,3) $P(BUF,U,2,3)=$G(FROM)_U_$G(FROM("IEN"))
  1.  S @RESULTS@(0)=BUF
  1.  Q
  1.  ;
  1.  ;***** RETURNS THE LIST OF HOSPITAL LOCATIONS
  1.  ; RPC: [ROR LIST HOSPITAL LOCATIONS]
  1.  ;
  1.  ; .RESULTS      Reference to a local variable where the results
  1.  ;               are returned to.
  1.  ;
  1.  ; [HLTYPES]     List of location types separated by commas (internal
  1.  ;               values of the TYPE field of the HOSPITAL LOCATION
  1.  ;               file). Only locations of the types defined by this
  1.  ;               parameter are selected by the procedure. By default
  1.  ;               ($G(HLTYPES)=""), all locations are selected.
  1.  ;
  1.  ; [DIVIEN]      Division IEN. If this parameter is defined and
  1.  ;               greater than zero then only the locations associated 
  1.  ;               with this division will be selected.
  1.  ;
  1.  ; [PART]        The partial match restriction.
  1.  ;
  1.  ; [FLAGS]       Flags that control the execution (can be combined):
  1.  ;                 A  Include active locations (default)
  1.  ;                 B  Backwards. Traverses the index in the opposite
  1.  ;                    direction of normal traversal.
  1.  ;                 I  Include inactive locations
  1.  ;
  1.  ; [NUMBER]      Maximum number of entries to return. A value of "*"
  1.  ;               or no value in this parameter designates all entries.
  1.  ;
  1.  ; [FROM]        The index entry(s) from which to begin the list
  1.  ;                 ^01: FromName
  1.  ;                 ^02: FromIEN
  1.  ;
  1.  ;               For example, a FROM value of "VA" would list entries
  1.  ;               following VA. You can use the 2-nd and 3-rd "^"-
  1.  ;               pieces of the @RESULTS@(0) node to continue the
  1.  ;               listing in the subsequent procedure calls.
  1.  ;
  1.  ;               NOTE: The FROM value itself is not included in
  1.  ;                     the resulting list.
  1.  ;
  1.  ; The ^TMP("DILIST",$J) global node is used by the procedure.
  1.  ;
  1.  ; See description of the LIST^DIC for more details about the
  1.  ; PART, NUMBER and FROM parameters.
  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 hospital locations and the value of the
  1.  ; FROM parameter for the next procedure call are returned in
  1.  ; the @RESULTS@(0) and the subsequent nodes of the global array
  1.  ; contain the locations.
  1.  ; 
  1.  ; @RESULTS@(0)          Result Descriptor
  1.  ;                         ^01: Number of locations
  1.  ;                         ^02: FromName
  1.  ;                         ^03: FromIEN
  1.  ;
  1.  ; @RESULTS@(i)          Hospital Location
  1.  ;                         ^01: IEN
  1.  ;                         ^02: Name
  1.  ;                         ^03: Type (internal)
  1.  ;                         ^04: Institution IEN
  1.  ;                         ^05: Division IEN
  1.  ;                         ^06: Active (0/1)
  1.  ;
  1.  ; NOTE: The 6th "^"-piece of the location record (Active) is
  1.  ;       populated only if both "A" and "I" flags are used.
  1.  ;
  1. HLOCLIST(RESULTS,HLTYPES,DIVIEN,PART,FLAGS,NUMBER,FROM) ;
  1.  N BUF,I,RC,RORERRDL,RORHLT,RORMSG,SCR,TMP
  1.  D CLEAR^RORERR("HLOCLIST^RORRP015",1)
  1.  K RESULTS  S RESULTS=$NA(^TMP("DILIST",$J))  K @RESULTS
  1.  ;--- Check the parameters
  1.  S HLTYPES=$$UP^XLFSTR($TR($G(HLTYPES)," "))
  1.  F I=1:1  S TMP=$P(HLTYPES,",",I)  Q:TMP=""  S RORHLT(TMP)=""
  1.  S DIVIEN=$S($G(DIVIEN)>0:+DIVIEN,1:0)
  1.  S PART=$G(PART),FLAGS=$G(FLAGS)
  1.  S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
  1.  ;--- If neither "A" nor "I" flag is provided, add the "A" (default)
  1.  S:$TR(FLAGS,"AI")=FLAGS FLAGS=FLAGS_"A"
  1.  ;--- Setup the start point
  1.  I $G(FROM)'=""  D  S FROM=$P(FROM,U)
  1.  . S:$P(FROM,U,2)>0 FROM("IEN")=+$P(FROM,U,2)
  1.  ;--- Compile the screen logic (be careful with naked references)
  1.  S SCR=""
  1.  D:$D(RORHLT)>1
  1.  . S SCR=SCR_"S D=$P($G(^(0)),U,3) I D'="""",$D(RORHLT(D)) "
  1.  S:DIVIEN SCR=SCR_"I $P($G(^(0)),U,15)=DIVIEN "
  1.  S:FLAGS'["A" SCR=SCR_"I '$$ACTLOC^RORRP015(+Y) "
  1.  S:FLAGS'["I" SCR=SCR_"I $$ACTLOC^RORRP015(+Y) "
  1.  ;--- Get the list of locations
  1.  S BUF="@;.01;2I;3I;3.5I",TMP="P"_$S(FLAGS["B":"B",1:"")
  1.  D LIST^DIC(44,,BUF,TMP,NUMBER,.FROM,PART,"B",SCR,,,"RORMSG")
  1.  I $G(DIERR)  D  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  . S RC=$$DBS^RORERR("RORMSG",-9,,,44)
  1.  . K ^TMP("DILIST",$J)
  1.  ;--- Populate the Active field if both flags are used
  1.  I FLAGS["I",FLAGS["A"  S I=0  D
  1.  . F  S I=$O(@RESULTS@(I))  Q:I=""  D
  1.  . . S $P(@RESULTS@(I,0),U,6)=$$ACTLOC(+@RESULTS@(I,0))
  1.  ;--- Success
  1.  S TMP=$G(^TMP("DILIST",$J,0)),BUF=+$P(TMP,U)
  1.  K ^TMP("DILIST",$J,0)
  1.  S:$P(TMP,U,3) $P(BUF,U,2,3)=$G(FROM)_U_$G(FROM("IEN"))
  1.  S @RESULTS@(0)=BUF
  1.  Q