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
|
---|