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

ORWPFSS1.m

Go to the documentation of this file. 
  1. ORWPFSS1 ;SLC/GSS - CPRS PFSS; 05/24/05 [05/24/05 11:44am]
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**228**;Dec 17, 1997
  1.  ; Sub-routines for phase II of the CPRS PFSS project (CPRS v26=phase I)
  1.  ;
  1.  Q
  1.  ;
  1. ACCTREF(ORIEN,ORACTREF) ;File PFSS Account Reference Number (ARN)
  1.  ; PFSS ARN stored as 1st piece of ^OR(100,ORIEN,5.5), aka Field #97
  1.  ; Call as an extrinsic function,i.e., $$ACCTREF^ORWPFSS1(ORIEN,ORACTREF)
  1.  ;
  1.  ; Input:
  1.  ;   ORIEN     Order internal reference number related to PFSS ARN
  1.  ;   ORACTREF  PFSS ARN to store, which is a pointer to File #375
  1.  ; Output:
  1.  ;   if error, returns #^reason, where #>1
  1.  ;   if valid, returns 1
  1.  ;
  1.  ; Additional variables used:
  1.  ;   ORERCK    error variable (error #^verbiage)
  1.  ;
  1.  ; new variables
  1.  N ARE,ORER,ORERCK,ORFDA,ORNEWER
  1.  ;
  1.  ; check for a valid ORIEN
  1.  S ORERCK=$$ORDERCK^ORWPFSS(ORIEN)
  1.  I +ORERCK>1 Q ORERCK
  1.  ;
  1.  ; check for pre-existing, non-null entry, if there is to be no editing
  1.  I $G(^OR(100,ORIEN,5.5))'="" Q 97_U_"PFSS Acct Ref # exists in Order file"
  1.  ; check that PFSS ARN is in a valid format
  1.  I '+ORACTREF Q 98_U_"PFSS is null or of invalid format"
  1.  ; check that PFSS ARN exists in PFSS Acount file #375 - DBIA #4741
  1.  I '$D(^IBBAA(375,ORACTREF,0)) Q 99_U_"PFSS Acct Ref # doesn't exist"
  1.  ;
  1.  ; store PARN (while checking for errors)
  1.  S ORERCK=$$STRPARN(ORIEN,ORACTREF)
  1.  Q ORERCK
  1.  ;
  1. EDO1 ; Event Delayed Orders called from EN1^ORCSEND for delayed releases
  1.  ;
  1.  ;  EIEN     = Release event IEN
  1.  ;  EPOINTER = Event pointer
  1.  ;  ETYPE    = Event type
  1.  ;  DFN      = Patient IEN
  1.  ;  ORACTREF = PFSS Account Reference Number
  1.  ;  ORERCK   = Order check results (1 = OK)
  1.  ;  ORIFN    = Order IEN (previously defined)
  1.  ;
  1.  ; new variables used
  1.  N EIEN,EPOINTER,ETYPE,DFN,ORACTREF,ORERCK,ORPFSS
  1.  ;
  1.  ; quit if PFSS is not active
  1.  D PFSSACTV^ORWPFSS(.ORPFSS) I ORPFSS=0 G EDO1Q
  1.  ;
  1.  ; check validity/support of order
  1.  S ORERCK=$$ORDERCK^ORWPFSS(ORIFN) I +ORERCK>1 G EDO1Q
  1.  ;
  1.  ; get Event Pointer
  1.  S EPOINTER=$P(^OR(100,ORIFN,0),U,17)
  1.  ; if EPOINTER is null then quit
  1.  I EPOINTER="" G EDO1Q
  1.  ;
  1.  ; get Release Event Record
  1.  S EIEN=$P(^ORE(100.2,EPOINTER,0),U,2)
  1.  ; if EIEN is null then quit
  1.  I EIEN="" G EDO1Q
  1.  ;
  1.  ; get Event Type
  1.  S ETYPE=$P(^ORD(100.5,EIEN,0),U,2)
  1.  ;
  1.  ; if ETYPE is Admission or Transfer get PFSS ARN from VADPT
  1.  I ETYPE="A"!(ETYPE="T") D
  1.  . ; set patient IEN (DFN)
  1.  . S DFN=$P($P(^OR(100,ORIFN,0),";"),U,2)
  1.  . ; call VADPT (hospital adm/txfr) routine to get PFSS ARN (ORACTREF)
  1.  . S ORACTREF=$$HAAR^ORWPFSS4(DFN)
  1.  . ; store PFSS ARN in Order file (#100)
  1.  . S X=$$STRPARN(ORIFN,ORACTREF)
  1.  ;
  1.  ; if ETYPE is Discharge store PFSS ARN as null in Order file (#100)
  1.  I ETYPE="D" S X=$$STRPARN(ORIFN,"")
  1.  ;
  1.  ; ???-course of action if errors or EPOINTER or EIEN null?
  1. EDO1Q Q
  1.  ;
  1. EDO2 ; Event Delayed Orders called from EN2^ORCSEND for manual releases
  1.  ; Get the PARN in effecxt when the event delayed order (EDO) released.
  1.  ;
  1.  ; Variables used:
  1.  ;  EIEN     = Release event IEN
  1.  ;  EPOINTER = Event pointer
  1.  ;  DFN      = Patient IEN
  1.  ;  ORACTREF = PFSS Account Reference Number
  1.  ;  ORERCK   = Order check results (1 = OK)
  1.  ;  ORIFN    = Order IEN (previously defined)
  1.  ;
  1.  ; new variables used
  1.  N EIEN,EPOINTER,ETYPE,DFN,ORACTREF,ORERCK,ORPFSS
  1.  ;
  1.  ; quit if PFSS is not active
  1.  D PFSSACTV^ORWPFSS(.ORPFSS) I ORPFSS=0 G EDO2Q
  1.  ;
  1.  ; check validity/support of order
  1.  S ORERCK=$$ORDERCK^ORWPFSS(ORIFN) I +ORERCK>1 G EDO2Q
  1.  ;
  1.  ; get Event Pointer
  1.  S EPOINTER=$P(^OR(100,ORIFN,0),U,17)
  1.  ; if EPOINTER is null then quit
  1.  I EPOINTER="" G EDO2Q
  1.  ;
  1.  ; get Release Event Record
  1.  S EIEN=$P(^ORE(100.2,EPOINTER,0),U,2)
  1.  ; if EIEN is null then quit
  1.  I EIEN="" G EDO2Q
  1.  ;
  1.  ; set patient IEN (DFN)
  1.  S DFN=$P($P(^OR(100,ORIFN,0),";"),U,2)
  1.  ; call VADPT (hospital adm/txfr) routine to get PFSS ARN (ORACTREF)
  1.  S ORACTREF=$$HAAR^ORWPFSS4(DFN)
  1.  ; store PFSS ARN in Order file (#100)
  1.  S X=$$STRPARN(ORIFN,ORACTREF)
  1.  ;
  1.  ; ???-course of action if errors or EPOINTER or EIEN null?
  1. EDO2Q Q
  1.  ;
  1. STRPARN(ORIEN,ORACTREF) ; store of PFSS ARN
  1.  ; stores PFSS Account Reference Number in the Order file #100, field 97
  1.  ; see ACCTREF for passed in variable descriptions
  1.  ;
  1.  ; Variables used:
  1.  ;   ORER      = Error message
  1.  ;   ORFIELD   = PFSS ARN field (#97)
  1.  ;   ORFILE    = ORDER file (#100)
  1.  ;   ORFLAGS   = null (flags used in controlling use of FDA^DIFL)
  1.  ;
  1.  ; new variables
  1.  N ORER,ORFILE,ORFIELD,ORFLAGS
  1.  ;
  1.  ; set contants
  1.  S ORFILE=100,ORFIELD=97,ORFLAGS=""
  1.  ;
  1.  ; do FDA loader to compose FDA_ROOT
  1.  D FDA^DILF(ORFILE,ORIEN,ORFIELD,ORFLAGS,ORACTREF,"ORFDA","ORER")
  1.  ; check for an error
  1.  D ERRCHK I $D(ORNEWER) Q ORER
  1.  ; file PFSS ARN in Order file
  1.  D UPDATE^DIE("","ORFDA","","ORER")
  1.  ; another error check
  1.  D ERRCHK I $D(ORNEWER) Q ORER
  1.  ; successful data
  1.  Q 1
  1.  ;
  1. ERRCHK ; Compose error message if there's an error from use of DILF or DIE
  1.  I $G(ORER("DIERR",1)) D
  1.  . S ORNEWER=$G(ORER("DIERR",1))_U_$G(ORER("DIERR",1,"TEXT",1))
  1.  Q