source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWPFSS.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1ORWPFSS ; 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 ;
8PFSSACTV(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 ;
22ORACTREF(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 ;
45ORDERCK(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 ;
65PKGTYP(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
Note: See TracBrowser for help on using the repository browser.