ORWPFSS ; SLC/REV/GSS - CPRS PFSS Calls; 11/15/04 [11/15/04 11:43am]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,228**;Dec 17, 1997
; Sub-routines for phase II of the CPRS PFSS project except for
; tag PFSSACTV which (with different code) is in CPRS v26 or phase I
;
Q
;
PFSSACTV(ORY) ; Is PFSS active for this system/user/etc?
; RPC called by Delphi to determine if passing visit string
;
; 1 = PFSS active - pass visit string with order
; 0 = PFSS not active - do not pass visit string
;
;$$SWSTAT^IBBAPI() WILL BE RELEASED IN IB*2*286, as per E.Zeigler
;
;Check for IB patch
S ORY=+$$PATCH^XPDUTL("IB*2.0*286") Q:ORY=0
;Check PFSS master switch status (1=On, 0=Off)
S ORY=+$$SWSTAT^IBBAPI() ;IA #4663
Q
;
ORACTREF(ORACTREF,ORIEN) ;Return PFSS Account Reference Number (ARN)
; PFSS ARN in order file (#100) as field #97, i.e., ^OR(100,ORIEN,5.5)
; This API is covered under IA #4673
;
; Access as D ORACTREF^ORWPFSS(.ORACTREF,ORIEN), where
; ORIEN Order IEN
; ORACTREF returned in internal format, i.e., pointer to file #375
;
; Input:
; ORIEN Order internal reference number related to PFSS ARN
; Output:
; ORACTREF PFSS Account Reference Number
;
; new variables
N ORERCK,ORPKG,OIREC,OIV,OIVN
; initialize PCE Account Reference Number variable
S ORACTREF=""
; check for a valid ORIEN
S ORERCK=$$ORDERCK(ORIEN) Q:+ORERCK>1
; get PFSS ARN from Order File (#100)
S ORACTREF=$$GET1^DIQ(100,ORIEN_",",97,"I","","")
Q
;
ORDERCK(ORIEN) ; check validity of Order IEN (ORIEN)
; used by ORWPFSS & ORWPFSS1, access as $$ORDERCK^ORWPFSS(ORIEN)
;
; Input:
; ORIEN Order internal reference number related to PFSS ARN
; Output:
; if error, returns #^reason, where #>1
; if valid, returns 1
;
; quit if ORIEN is null
I $G(ORIEN)="" Q 90_U_"ORIEN IS NULL"
; quit if order is a document/note, i.e., not an order
I ORIEN=0 Q 91_U_"ORIEN IS A DOCUMENT/NOTE"
; quit if ORIEN value is invalid, e.g., no such order
I $D(^OR(100,ORIEN,0))'=1 Q 92_U_"ORIEN IS AN INVALID ORDER NUMBER"
; determine if package type supported
I '$$PKGTYP(ORIEN) Q 93_U_"PACKAGE TYPE NOT SUPPORTED"
; ORIEN is valid
Q 1
;
PKGTYP(ORIEN) ; Build CPRS PFSS supported packages array
; returns 1 if order package type supported, otherwise returns 0
; LR=Lab, RA=Radiology
; to add a package, include it above (documentation) & in For stmt below
;
N I,ORPKG,ORPKGARY
F I=1:1 S ORPKG=$P("LR;RA",";",I) Q:ORPKG="" D
. ; create ORPKGARY array of supported package types
. S ORPKGARY(+$O(^DIC(9.4,"C",ORPKG,0)))=ORPKG ; ^DIC(9.4) is pkg file
; yes, order passed is of a package type that is supported
I $D(ORPKGARY($P(^OR(100,ORIEN,0),U,14))) Q 1
Q 0 ; package type not supported
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPFSS 2811 printed Sep 23, 2025@20:13:22 Page 2
ORWPFSS ; SLC/REV/GSS - CPRS PFSS Calls; 11/15/04 [11/15/04 11:43am]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,228**;Dec 17, 1997
+2 ; Sub-routines for phase II of the CPRS PFSS project except for
+3 ; tag PFSSACTV which (with different code) is in CPRS v26 or phase I
+4 ;
+5 QUIT
+6 ;
PFSSACTV(ORY) ; Is PFSS active for this system/user/etc?
+1 ; RPC called by Delphi to determine if passing visit string
+2 ;
+3 ; 1 = PFSS active - pass visit string with order
+4 ; 0 = PFSS not active - do not pass visit string
+5 ;
+6 ;$$SWSTAT^IBBAPI() WILL BE RELEASED IN IB*2*286, as per E.Zeigler
+7 ;
+8 ;Check for IB patch
+9 SET ORY=+$$PATCH^XPDUTL("IB*2.0*286")
if ORY=0
QUIT
+10 ;Check PFSS master switch status (1=On, 0=Off)
+11 ;IA #4663
SET ORY=+$$SWSTAT^IBBAPI()
+12 QUIT
+13 ;
ORACTREF(ORACTREF,ORIEN) ;Return PFSS Account Reference Number (ARN)
+1 ; PFSS ARN in order file (#100) as field #97, i.e., ^OR(100,ORIEN,5.5)
+2 ; This API is covered under IA #4673
+3 ;
+4 ; Access as D ORACTREF^ORWPFSS(.ORACTREF,ORIEN), where
+5 ; ORIEN Order IEN
+6 ; ORACTREF returned in internal format, i.e., pointer to file #375
+7 ;
+8 ; Input:
+9 ; ORIEN Order internal reference number related to PFSS ARN
+10 ; Output:
+11 ; ORACTREF PFSS Account Reference Number
+12 ;
+13 ; new variables
+14 NEW ORERCK,ORPKG,OIREC,OIV,OIVN
+15 ; initialize PCE Account Reference Number variable
+16 SET ORACTREF=""
+17 ; check for a valid ORIEN
+18 SET ORERCK=$$ORDERCK(ORIEN)
if +ORERCK>1
QUIT
+19 ; get PFSS ARN from Order File (#100)
+20 SET ORACTREF=$$GET1^DIQ(100,ORIEN_",",97,"I","","")
+21 QUIT
+22 ;
ORDERCK(ORIEN) ; check validity of Order IEN (ORIEN)
+1 ; used by ORWPFSS & ORWPFSS1, access as $$ORDERCK^ORWPFSS(ORIEN)
+2 ;
+3 ; Input:
+4 ; ORIEN Order internal reference number related to PFSS ARN
+5 ; Output:
+6 ; if error, returns #^reason, where #>1
+7 ; if valid, returns 1
+8 ;
+9 ; quit if ORIEN is null
+10 IF $GET(ORIEN)=""
QUIT 90_U_"ORIEN IS NULL"
+11 ; quit if order is a document/note, i.e., not an order
+12 IF ORIEN=0
QUIT 91_U_"ORIEN IS A DOCUMENT/NOTE"
+13 ; quit if ORIEN value is invalid, e.g., no such order
+14 IF $DATA(^OR(100,ORIEN,0))'=1
QUIT 92_U_"ORIEN IS AN INVALID ORDER NUMBER"
+15 ; determine if package type supported
+16 IF '$$PKGTYP(ORIEN)
QUIT 93_U_"PACKAGE TYPE NOT SUPPORTED"
+17 ; ORIEN is valid
+18 QUIT 1
+19 ;
PKGTYP(ORIEN) ; Build CPRS PFSS supported packages array
+1 ; returns 1 if order package type supported, otherwise returns 0
+2 ; LR=Lab, RA=Radiology
+3 ; to add a package, include it above (documentation) & in For stmt below
+4 ;
+5 NEW I,ORPKG,ORPKGARY
+6 FOR I=1:1
SET ORPKG=$PIECE("LR;RA",";",I)
if ORPKG=""
QUIT
Begin DoDot:1
+7 ; create ORPKGARY array of supported package types
+8 ; ^DIC(9.4) is pkg file
SET ORPKGARY(+$ORDER(^DIC(9.4,"C",ORPKG,0)))=ORPKG
End DoDot:1
+9 ; yes, order passed is of a package type that is supported
+10 IF $DATA(ORPKGARY($PIECE(^OR(100,ORIEN,0),U,14)))
QUIT 1
+11 ; package type not supported
QUIT 0
