- 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 Jan 18, 2025@03:38:12 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