| [613] | 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
 | 
|---|