ORWPFSS.m

ORWPFSS ; SLC/REV/GSS - CPRS PFSS Calls;08-Feb-2012 16:47;PLS

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,228,1010**;Dec 17, 1997;Build 47

 ; 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

 ;

 ; Modified - IHS/MSC/PLS - 02/08/2012 - Line PFSSACTV+11

 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)

 ;IHS/MSC/PLS - 02/08/2012

 ;S ORY=+$$SWSTAT^IBBAPI()  ;IA #4663

 S ORY=0

 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

ORWPFSS   ; SLC/REV/GSS - CPRS PFSS Calls;08-Feb-2012 16:47;PLS

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,228,1010**;Dec 17, 1997;Build 47

 +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       ; Modified - IHS/MSC/PLS - 02/08/2012 - Line PFSSACTV+11

 +6        QUIT 

 +7       ;

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      ;IHS/MSC/PLS - 02/08/2012

 +12      ;S ORY=+$$SWSTAT^IBBAPI()  ;IA #4663

 +13       SET ORY=0

 +14       QUIT 

 +15      ;

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