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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPFSS1 5015 printed Sep 23, 2025@20:13:24 Page 2
ORWPFSS1 ;SLC/GSS - CPRS PFSS; 05/24/05 [05/24/05 11:44am]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**228**;Dec 17, 1997
+2 ; Sub-routines for phase II of the CPRS PFSS project (CPRS v26=phase I)
+3 ;
+4 QUIT
+5 ;
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
+2 ; Call as an extrinsic function,i.e., $$ACCTREF^ORWPFSS1(ORIEN,ORACTREF)
+3 ;
+4 ; Input:
+5 ; ORIEN Order internal reference number related to PFSS ARN
+6 ; ORACTREF PFSS ARN to store, which is a pointer to File #375
+7 ; Output:
+8 ; if error, returns #^reason, where #>1
+9 ; if valid, returns 1
+10 ;
+11 ; Additional variables used:
+12 ; ORERCK error variable (error #^verbiage)
+13 ;
+14 ; new variables
+15 NEW ARE,ORER,ORERCK,ORFDA,ORNEWER
+16 ;
+17 ; check for a valid ORIEN
+18 SET ORERCK=$$ORDERCK^ORWPFSS(ORIEN)
+19 IF +ORERCK>1
QUIT ORERCK
+20 ;
+21 ; check for pre-existing, non-null entry, if there is to be no editing
+22 IF $GET(^OR(100,ORIEN,5.5))'=""
QUIT 97_U_"PFSS Acct Ref # exists in Order file"
+23 ; check that PFSS ARN is in a valid format
+24 IF '+ORACTREF
QUIT 98_U_"PFSS is null or of invalid format"
+25 ; check that PFSS ARN exists in PFSS Acount file #375 - DBIA #4741
+26 IF '$DATA(^IBBAA(375,ORACTREF,0))
QUIT 99_U_"PFSS Acct Ref # doesn't exist"
+27 ;
+28 ; store PARN (while checking for errors)
+29 SET ORERCK=$$STRPARN(ORIEN,ORACTREF)
+30 QUIT ORERCK
+31 ;
EDO1 ; Event Delayed Orders called from EN1^ORCSEND for delayed releases
+1 ;
+2 ; EIEN = Release event IEN
+3 ; EPOINTER = Event pointer
+4 ; ETYPE = Event type
+5 ; DFN = Patient IEN
+6 ; ORACTREF = PFSS Account Reference Number
+7 ; ORERCK = Order check results (1 = OK)
+8 ; ORIFN = Order IEN (previously defined)
+9 ;
+10 ; new variables used
+11 NEW EIEN,EPOINTER,ETYPE,DFN,ORACTREF,ORERCK,ORPFSS
+12 ;
+13 ; quit if PFSS is not active
+14 DO PFSSACTV^ORWPFSS(.ORPFSS)
IF ORPFSS=0
GOTO EDO1Q
+15 ;
+16 ; check validity/support of order
+17 SET ORERCK=$$ORDERCK^ORWPFSS(ORIFN)
IF +ORERCK>1
GOTO EDO1Q
+18 ;
+19 ; get Event Pointer
+20 SET EPOINTER=$PIECE(^OR(100,ORIFN,0),U,17)
+21 ; if EPOINTER is null then quit
+22 IF EPOINTER=""
GOTO EDO1Q
+23 ;
+24 ; get Release Event Record
+25 SET EIEN=$PIECE(^ORE(100.2,EPOINTER,0),U,2)
+26 ; if EIEN is null then quit
+27 IF EIEN=""
GOTO EDO1Q
+28 ;
+29 ; get Event Type
+30 SET ETYPE=$PIECE(^ORD(100.5,EIEN,0),U,2)
+31 ;
+32 ; if ETYPE is Admission or Transfer get PFSS ARN from VADPT
+33 IF ETYPE="A"!(ETYPE="T")
Begin DoDot:1
+34 ; set patient IEN (DFN)
+35 SET DFN=$PIECE($PIECE(^OR(100,ORIFN,0),";"),U,2)
+36 ; call VADPT (hospital adm/txfr) routine to get PFSS ARN (ORACTREF)
+37 SET ORACTREF=$$HAAR^ORWPFSS4(DFN)
+38 ; store PFSS ARN in Order file (#100)
+39 SET X=$$STRPARN(ORIFN,ORACTREF)
End DoDot:1
+40 ;
+41 ; if ETYPE is Discharge store PFSS ARN as null in Order file (#100)
+42 IF ETYPE="D"
SET X=$$STRPARN(ORIFN,"")
+43 ;
+44 ; ???-course of action if errors or EPOINTER or EIEN null?
EDO1Q QUIT
+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.
+2 ;
+3 ; Variables used:
+4 ; EIEN = Release event IEN
+5 ; EPOINTER = Event pointer
+6 ; DFN = Patient IEN
+7 ; ORACTREF = PFSS Account Reference Number
+8 ; ORERCK = Order check results (1 = OK)
+9 ; ORIFN = Order IEN (previously defined)
+10 ;
+11 ; new variables used
+12 NEW EIEN,EPOINTER,ETYPE,DFN,ORACTREF,ORERCK,ORPFSS
+13 ;
+14 ; quit if PFSS is not active
+15 DO PFSSACTV^ORWPFSS(.ORPFSS)
IF ORPFSS=0
GOTO EDO2Q
+16 ;
+17 ; check validity/support of order
+18 SET ORERCK=$$ORDERCK^ORWPFSS(ORIFN)
IF +ORERCK>1
GOTO EDO2Q
+19 ;
+20 ; get Event Pointer
+21 SET EPOINTER=$PIECE(^OR(100,ORIFN,0),U,17)
+22 ; if EPOINTER is null then quit
+23 IF EPOINTER=""
GOTO EDO2Q
+24 ;
+25 ; get Release Event Record
+26 SET EIEN=$PIECE(^ORE(100.2,EPOINTER,0),U,2)
+27 ; if EIEN is null then quit
+28 IF EIEN=""
GOTO EDO2Q
+29 ;
+30 ; set patient IEN (DFN)
+31 SET DFN=$PIECE($PIECE(^OR(100,ORIFN,0),";"),U,2)
+32 ; call VADPT (hospital adm/txfr) routine to get PFSS ARN (ORACTREF)
+33 SET ORACTREF=$$HAAR^ORWPFSS4(DFN)
+34 ; store PFSS ARN in Order file (#100)
+35 SET X=$$STRPARN(ORIFN,ORACTREF)
+36 ;
+37 ; ???-course of action if errors or EPOINTER or EIEN null?
EDO2Q QUIT
+1 ;
STRPARN(ORIEN,ORACTREF) ; store of PFSS ARN
+1 ; stores PFSS Account Reference Number in the Order file #100, field 97
+2 ; see ACCTREF for passed in variable descriptions
+3 ;
+4 ; Variables used:
+5 ; ORER = Error message
+6 ; ORFIELD = PFSS ARN field (#97)
+7 ; ORFILE = ORDER file (#100)
+8 ; ORFLAGS = null (flags used in controlling use of FDA^DIFL)
+9 ;
+10 ; new variables
+11 NEW ORER,ORFILE,ORFIELD,ORFLAGS
+12 ;
+13 ; set contants
+14 SET ORFILE=100
SET ORFIELD=97
SET ORFLAGS=""
+15 ;
+16 ; do FDA loader to compose FDA_ROOT
+17 DO FDA^DILF(ORFILE,ORIEN,ORFIELD,ORFLAGS,ORACTREF,"ORFDA","ORER")
+18 ; check for an error
+19 DO ERRCHK
IF $DATA(ORNEWER)
QUIT ORER
+20 ; file PFSS ARN in Order file
+21 DO UPDATE^DIE("","ORFDA","","ORER")
+22 ; another error check
+23 DO ERRCHK
IF $DATA(ORNEWER)
QUIT ORER
+24 ; successful data
+25 QUIT 1
+26 ;
ERRCHK ; Compose error message if there's an error from use of DILF or DIE
+1 IF $GET(ORER("DIERR",1))
Begin DoDot:1
+2 SET ORNEWER=$GET(ORER("DIERR",1))_U_$GET(ORER("DIERR",1,"TEXT",1))
End DoDot:1
+3 QUIT
