| 1 | ORWPFSS ; SLC/REV/GSS - CPRS PFSS Calls; 11/15/04 [11/15/04 11:43am] | 
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,228**;Dec 17, 1997 | 
|---|
| 3 | ; Sub-routines for phase II of the CPRS PFSS project except for | 
|---|
| 4 | ;   tag PFSSACTV which (with different code) is in CPRS v26 or phase I | 
|---|
| 5 | ; | 
|---|
| 6 | Q | 
|---|
| 7 | ; | 
|---|
| 8 | PFSSACTV(ORY) ; Is PFSS active for this system/user/etc? | 
|---|
| 9 | ; RPC called by Delphi to determine if passing visit string | 
|---|
| 10 | ; | 
|---|
| 11 | ; 1 = PFSS active - pass visit string with order | 
|---|
| 12 | ; 0 = PFSS not active - do not pass visit string | 
|---|
| 13 | ; | 
|---|
| 14 | ;$$SWSTAT^IBBAPI() WILL BE RELEASED IN IB*2*286, as per E.Zeigler | 
|---|
| 15 | ; | 
|---|
| 16 | ;Check for IB patch | 
|---|
| 17 | S ORY=+$$PATCH^XPDUTL("IB*2.0*286") Q:ORY=0 | 
|---|
| 18 | ;Check PFSS master switch status (1=On, 0=Off) | 
|---|
| 19 | S ORY=+$$SWSTAT^IBBAPI()  ;IA #4663 | 
|---|
| 20 | Q | 
|---|
| 21 | ; | 
|---|
| 22 | ORACTREF(ORACTREF,ORIEN) ;Return PFSS Account Reference Number (ARN) | 
|---|
| 23 | ; PFSS ARN in order file (#100) as field #97, i.e., ^OR(100,ORIEN,5.5) | 
|---|
| 24 | ; This API is covered under IA #4673 | 
|---|
| 25 | ; | 
|---|
| 26 | ; Access as D ORACTREF^ORWPFSS(.ORACTREF,ORIEN), where | 
|---|
| 27 | ;    ORIEN      Order IEN | 
|---|
| 28 | ;    ORACTREF   returned in internal format, i.e., pointer to file #375 | 
|---|
| 29 | ; | 
|---|
| 30 | ; Input: | 
|---|
| 31 | ;   ORIEN     Order internal reference number related to PFSS ARN | 
|---|
| 32 | ; Output: | 
|---|
| 33 | ;   ORACTREF  PFSS Account Reference Number | 
|---|
| 34 | ; | 
|---|
| 35 | ; new variables | 
|---|
| 36 | N ORERCK,ORPKG,OIREC,OIV,OIVN | 
|---|
| 37 | ; initialize PCE Account Reference Number variable | 
|---|
| 38 | S ORACTREF="" | 
|---|
| 39 | ; check for a valid ORIEN | 
|---|
| 40 | S ORERCK=$$ORDERCK(ORIEN) Q:+ORERCK>1 | 
|---|
| 41 | ; get PFSS ARN from Order File (#100) | 
|---|
| 42 | S ORACTREF=$$GET1^DIQ(100,ORIEN_",",97,"I","","") | 
|---|
| 43 | Q | 
|---|
| 44 | ; | 
|---|
| 45 | ORDERCK(ORIEN) ; check validity of Order IEN (ORIEN) | 
|---|
| 46 | ; used by ORWPFSS & ORWPFSS1, access as $$ORDERCK^ORWPFSS(ORIEN) | 
|---|
| 47 | ; | 
|---|
| 48 | ; Input: | 
|---|
| 49 | ;   ORIEN    Order internal reference number related to PFSS ARN | 
|---|
| 50 | ; Output: | 
|---|
| 51 | ;   if error, returns #^reason, where #>1 | 
|---|
| 52 | ;   if valid, returns 1 | 
|---|
| 53 | ; | 
|---|
| 54 | ; quit if ORIEN is null | 
|---|
| 55 | I $G(ORIEN)="" Q 90_U_"ORIEN IS NULL" | 
|---|
| 56 | ; quit if order is a document/note, i.e., not an order | 
|---|
| 57 | I ORIEN=0 Q 91_U_"ORIEN IS A DOCUMENT/NOTE" | 
|---|
| 58 | ; quit if ORIEN value is invalid, e.g., no such order | 
|---|
| 59 | I $D(^OR(100,ORIEN,0))'=1 Q 92_U_"ORIEN IS AN INVALID ORDER NUMBER" | 
|---|
| 60 | ; determine if package type supported | 
|---|
| 61 | I '$$PKGTYP(ORIEN) Q 93_U_"PACKAGE TYPE NOT SUPPORTED" | 
|---|
| 62 | ; ORIEN is valid | 
|---|
| 63 | Q 1 | 
|---|
| 64 | ; | 
|---|
| 65 | PKGTYP(ORIEN) ; Build CPRS PFSS supported packages array | 
|---|
| 66 | ; returns 1 if order package type supported, otherwise returns 0 | 
|---|
| 67 | ; LR=Lab, RA=Radiology | 
|---|
| 68 | ; to add a package, include it above (documentation) & in For stmt below | 
|---|
| 69 | ; | 
|---|
| 70 | N I,ORPKG,ORPKGARY | 
|---|
| 71 | F I=1:1 S ORPKG=$P("LR;RA",";",I) Q:ORPKG=""  D | 
|---|
| 72 | . ; create ORPKGARY array of supported package types | 
|---|
| 73 | . S ORPKGARY(+$O(^DIC(9.4,"C",ORPKG,0)))=ORPKG  ; ^DIC(9.4) is pkg file | 
|---|
| 74 | ; yes, order passed is of a package type that is supported | 
|---|
| 75 | I $D(ORPKGARY($P(^OR(100,ORIEN,0),U,14))) Q 1 | 
|---|
| 76 | Q 0  ; package type not supported | 
|---|