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

PXUTL1.m

Go to the documentation of this file. 
  1. PXUTL1 ;ISL/dee - Utility routines used by PCE ;4/3/97
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**25**;Aug 12, 1996
  1.  ;; ;
  1.  Q
  1.  ;
  1. EXTTEXT(IEN,REQUIRED,FILE,FIELD1,FIELD2) ;Returns the external form.
  1.  ;Parameters:
  1.  ;  IEN       the ien in the file that the text is wanted for.
  1.  ;  REQUIRED  if this is not zero and no text is found
  1.  ;              then "UNKNOWN" is returned.
  1.  ;  FILE      the file number
  1.  ;  FIELD1    the field number that the text is in
  1.  ;  FIELD2    if the parameter is passed and there is no text
  1.  ;              in field1 then the text in this field will be
  1.  ;              returned if there is some.
  1.  ;
  1.  N DIC,DR,DA,DIQ,PXUTDIQ1,PXTEXT,Y,X
  1.  I $G(FILE)>0,$G(FIELD1)>0 D
  1.  . S DIC=FILE
  1.  . S DR=FIELD1
  1.  . S:$G(FIELD2)>0 DR=DR_";"_FIELD2
  1.  . S DA=IEN
  1.  . S DIQ="PXUTDIQ1("
  1.  . S DIQ(0)="E"
  1.  . D EN^DIQ1
  1.  . I PXUTDIQ1(FILE,DA,FIELD1,"E")]"" S PXTEXT=PXUTDIQ1(FILE,DA,FIELD1,"E")
  1.  . E  I $G(FIELD2)>0,PXUTDIQ1(FILE,DA,FIELD2,"E")]"" S PXTEXT=PXUTDIQ1(FILE,DA,FIELD2,"E")
  1.  . E  I REQUIRED S PXTEXT="UNKNOWN"
  1.  E  I REQUIRED S PXTEXT="UNKNOWN"
  1.  Q PXTEXT
  1.  ;
  1. PRIMVPRV(PXUTVST) ;Returns the primary provider if there is one
  1.  ;                 for the passed visit otherwise returns 0.
  1.  N PXCATEMP
  1.  S PXCATEMP=$$PRIMSEC(PXUTVST,"^AUPNVPRV",0,4)
  1.  Q $S(PXCATEMP>0:$P(^AUPNVPRV(PXCATEMP,0),"^"),1:0)
  1.  ;
  1. PRIMVPOV(PXUTVST) ;Returns the primary diagnosis if there is one
  1.  ;         for the passed visit otherwise returns 0.
  1.  N PXCATEMP
  1.  S PXCATEMP=$$PRIMSEC(PXUTVST,"^AUPNVPOV",0,12)
  1.  Q $S(PXCATEMP>0:$P(^AUPNVPOV(PXCATEMP,0),"^"),1:0)
  1.  ;
  1. PRIMSEC(PXUTVST,PXUTAUPN,PXUTNODE,PXUPIECE) ;Returns ien of the primary one
  1.  ;         if there is one for the passed visit otherwise returns 0.
  1.  ; Parameters:
  1.  ;   PXUTVST   Pointer to the visit
  1.  ;   PXUTAUPN  V-File global e.g. "^AUPNVPRV"
  1.  ;   PXUTNODE  The node that the Primary/Secondary field is on
  1.  ;   PXUPIECE  The piece of the Primary/Secondary field
  1.  ;
  1.  N PXUTPRIM
  1.  S PXUTPRIM=0
  1.  F  S PXUTPRIM=$O(@(PXUTAUPN_"(""AD"",PXUTVST,PXUTPRIM)")) Q:PXUTPRIM'>0  I "P"=$P(@(PXUTAUPN_"(PXUTPRIM,PXUTNODE)"),"^",PXUPIECE) Q
  1.  Q +PXUTPRIM
  1.  ;
  1. DISPOSIT(PXUTLDFN,PXUTLDT,PXUTVIEN) ;Checks to see if a visit is a dispoition
  1.  I PXUTVIEN=+$P($G(^SCE(+$P($G(^DPT(+PXUTLDFN,"DIS",9999999-PXUTLDT,0)),"^",18),0)),"^",5) Q +$P($G(^DPT(+PXUTLDFN,"DIS",9999999-PXUTLDT,0)),"^",18)
  1.  Q 0
  1.  ;
  1. APPOINT(PXUTLDFN,PXUTLDT,HLOC) ;Returns 1 if the patient has and appointment
  1.  ;at PXUTLDT for clinic HLOC.
  1.  Q HLOC=+$G(^DPT(+PXUTLDFN,"S",+PXUTLDT,0))
  1.  ;
  1. VST2APPT(VISIT) ;Is this visit related to an appointment
  1.  ;Returns
  1.  ; 1 if the visit is being pointed to by an appointment
  1.  ; 0 if the visit is NOT being pointed to by an appointment
  1.  ;-1 if the visit is invalued
  1.  ;
  1.  N VISIT0
  1.  S VISIT0=$G(^AUPNVSIT($G(VISIT),0))
  1.  Q:VISIT0="" -1
  1.  Q $$VSTAPPT($P(VISIT0,"^",5),$P(VISIT0,"^",1),$P(VISIT0,"^",22),VISIT)
  1.  ;
  1. VSTAPPT(PXUTLPAT,PXUTLDT,PXUTLLOC,PXUTLVST) ;Returns 1 if the visit is being pointed to by an
  1.  ;                appointment otherwise 0.
  1.  I PXUTLLOC]"",PXUTLLOC=+$G(^DPT(+PXUTLPAT,"S",+PXUTLDT,0)),PXUTLVST=+$P($G(^SCE(+$P($G(^DPT(PXUTLPAT,"S",PXUTLDT,0)),"^",20),0)),"^",5) Q 1
  1.  Q 0
  1.  ;
  1. APPT2VST(PXUTLPAT,PXUTLDT,HLOC) ;Returns ien of visit that the related
  1.  ;appointment points to at PXUTLDT for clinic HLOC otherwise 0.
  1.  I HLOC=+$G(^DPT(+PXUTLPAT,"S",+PXUTLDT,0)) Q +$P($G(^SCE(+$P($G(^DPT(PXUTLPAT,"S",PXUTLDT,0)),"^",20),0)),"^",5)
  1.  Q 0
  1.  ;