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