PSODIR4 ;EPIP/RTW - Outpatient Site High Cost Related Calls ; 3/30/18 11:30am
;;7.0;OUTPATIENT PHARMACY;**452**;Dec 1997;Build 56
;------------------------------------------------------------------
; ICR# TYPE DESCRIPTION
;----- --------- --------------------------------------------
; 2056 Supported $$GET1^DIQ
;10026 Supported ^DIR
;------------------------------------------------------------------
OPTSITE(PSOTRGET,PSORTN,PSOSCREN) ; Prompt for Outpatient Site when the host site
; has multiple OUTPATIENT SITE file (#59) entries.
;
; Input:
; PSOTRGET ; Required ; Name of output variable/array, passed by
; reference.
; PSORTN ; Required ; Name of calling routine, usually $T(+0)
; PSOSCREN ; Optional ;
; 0 ; By default, no screening of entries will take place
; 1 ; Optionally, only active OUTPATIENT SITE entries
; Output: ;
; The passed name of the PSOTRGET will be used in all output as
; follows:
; PSOTRGET=User's response from FM DIR API prompt
; PSOTRGET(PSOIEN59)=NAME (of OUTPATIENT SITE file (#59) entry)
; PSOTRGET("PSOSCNT")=Number of selected OUTPATIENT SITE entries
; - or -
; PSOTRGET="^" ; If an error occurs, user times out or enters '^'
;
; Intended usage:
; List the host computer's OUTPATIENT SITE entries allowing
; the user to select any combination of those entries, for example
; if there are 5 active OUTPATIENT SITEs, the user can select one
; of the following: 1 1-3 1,2,5
;
; Example calls:
; 1. Allow both active and/or inactive entries to be selected:
; D OPTSITE^PSODIR4(.PSOTRGET,$T(+0)) G:PSOTRGET="^" EXIT
; 2. Allow only active OUTPATIENT SITE entries to be selected:
; D OPTSITE^PSODIR4(.PSOTRGET,$T(+0),1) G:PSOTRGET="^" EXIT
;
KILL PSOTRGET ; Start with fresh output
S PSOSCREN=$G(PSOSCREN,0) ; Set optional screen to zero (avoid screening)
;
; Place selectable OUTPATIENT SITE entries in array:
; PSOINPUT(Sequential#)=PSOIEN59_"^"_PSOSITNM
;
N PSOSCNT,PSODTINAC,PSOIEN59,PSOINPUT,PSOEXIT,PSOSITNM
S (PSOSCNT,PSOIEN59)=0 ; PSOSCNT=Count the number of selectable OUTPATIENT SITEs
F S PSOIEN59=$O(^PS(59,PSOIEN59)) Q:'PSOIEN59 D ;
. S PSOSITNM=$$GET1^DIQ(59,PSOIEN59,.01) ; OUTPATIENT SITE NAME (#.01)
. I PSOSCREN=1 D Q:PSOEXIT="^" ; Keep only active sites
. . S PSOEXIT=0
. . S PSODTINAC=$$GET1^DIQ(59,PSOIEN59,2004,"I") ; INACTIVE DATE (#2004)
. . I PSODTINAC,PSODTINAC'>DT S PSOEXIT="^" Q ;. Bypass inactive site
. S PSOSCNT=PSOSCNT+1
. S PSOINPUT(PSOSCNT)=PSOIEN59_"^"_PSOSITNM
;
I PSOSCNT=1 D Q ; When PSOSCNT of entries = 1, no need to prompt user
. S PSOIEN59=$P(PSOINPUT(PSOSCNT),U,1),PSOSITNM=$P(PSOINPUT(PSOSCNT),U,2)
. S PSOTRGET(PSOIEN59)=PSOSITNM ; PSOTRGET is the single Outpatient Site
. S PSOTRGET("PSOSCNT")=1,PSOTRGET=""
I PSOSCNT=0 S PSOTRGET="^" Q ; No active OUTPATIENT SITE entries found
;
; Display the selectable OUTPATIENT SITE entries from the INPUT
; array previously created above.
;
W !
W !,"For RXs written at OUTPATIENT SITE(s): (Example 1,3 or 1-5)"
;
N PSOSCNT,PSOIEN59,PSOMAX
S (PSOSCNT,PSOMAX)=0 ; MAX=Count the number of selectable OUTPATIENT SITEs
F S PSOSCNT=$O(PSOINPUT(PSOSCNT)) Q:'PSOSCNT D ;
. S PSOIEN59=$P(PSOINPUT(PSOSCNT),U),PSOSITNM=$P(PSOINPUT(PSOSCNT),U,2)
. W !?3,$J(PSOSCNT,2),") ",PSOSITNM
. S PSOMAX=PSOMAX+1
;
; Prepare for DIR (list or range) API to prompt for selected sites
;
N %,DA,DIR,DIRUT,DTOUT,DUOUT,I,X,Y ; DIR API variables
N PSODEF
;
S DIR("A")="Select NUMBER(s): " ;DIR prompt text
S PSODEF=$G(^DISV(DUZ,PSORTN,"PSOSITE"),"1-"_PSOMAX) S:PSODEF]"" DIR("B")=PSODEF
; Note: Previously defaulted site might be inactivated, making the
; previous default range too large
I $P(DIR("B"),"-",2)>PSOMAX S DIR("B")="1-"_PSOMAX
;
; DIR(0) notes
; L=List or range format A=Nothing can be appended to DIC("A")
; O=User response is prompt is optional
; Select from 1 to MAXimum selectable range
S DIR(0)="LAO^1:"_PSOMAX ; User may select list or range from 1 to PSOMAX
;
D ^DIR
;
I $G(DTOUT) S PSOTRGET="^" Q ; User time out at DIR prompt
S PSOTRGET=X I PSOTRGET["^" S PSOTRGET="^" Q ;User up-arrow out at DIR prompt
;
; Build output PSOTRGET(PSOIEN59)=PSOSITNM from the comma delimited
; output varible Y of the FM DIR API. Example DIR output: Y="1,3,5,"
;
N PSOIEN59,PCE,SUB
F PCE=1:1 S SUB=$P(Y,",",PCE) Q:'SUB D ;
. S PSOIEN59=$P(PSOINPUT(SUB),U,1),PSOSITNM=$P(PSOINPUT(SUB),U,2)
. S PSOTRGET(PSOIEN59)=PSOSITNM
S PSOTRGET("PSOSCNT")=$L(Y,",")-1 ; Number of selected PSOTRGET entries
;
S:PSOTRGET'["^" ^DISV(DUZ,PSORTN,"PSOSITE")=PSOTRGET ; Next default
;
Q
DIVOK(INARRAY,XREF,RX0,RX1) ; Return: 1 if the division of the RX is OK
; 0 if the division does not match a specified input selection
;
; Assumptions:
; This call was designed to work with an Original RX, a Refilled
; RX, or a Partial RX.
; Cross References potentially utilized by calling routines
; Original RX: ^PSRX("AL",Released_Dt,RX0,0)=""
; Refilled RX: ^PSRX("AL",Released_Dt,RX0,RX1)=""
; Partial RX: ^PSRX("AM",Released_Dt,RX0,RX1)=""
; Input:
; INARRAY ; Required ; Usually as the result from a previous
; execution of the above companion call OPTSITE^PSOZDIR4
; INARRAY(PSOIEN)=VALUE ; Example: INARRAY(1)="JOHN COCHRAN VAMC"
; INARRAY("B",VALUE,PSOIEN)="" ; INARRAY("B","JOHN COCHRAN VAMC",1)=""
; XREF ; Required ; Type of x-ref, where
; 'AL' ; Indicates a either an original RX when RX1=0
; Indicates a refilled (multiple) RX when RX1>0
; 'AM' ; Indicates a partial (multiple) RX
; Note: See routine PSOSCT10 as an example, used by the
; option High Cost Rx Report [PSO HI COST].
; RX0 ; Required ; IEN of PRESCRIPTION file #52 entry
; RX1 ; Required ; IEN1 of Refill or a Partial RX multiple entry.
; Output:
; This extrinsic functions returns 1 (true) or 0 (false)
; Intended usage:
; This purpose of this API is to screen a particular RX for report
; inclusion or exclusion, that is, if the RX was dispensed at a
; previously selected Outpatient Site it should be included. In
; this, the extrinsic function will return a one (1). If the RX
; was not dispensed at a selected Outpatient Site, it should be
; excluded and the extrinsic function will return a zero (0).
; Althought this API can be used independently, this entry point
; was written as a companion call to be utilized after calling the
; OPTSITE^PSOZDIR4 API.
; Example call:
; ; Prompt for which Outptient Site(s) to include
; D OPTSITE^PSOZDIR4(.PSOSITE,$T(+0)) G:PSOSITE="^" EXIT
; ; When looping thru entries in file (#52), screen
; ; the RX to only include a selected Outpatient Site.
; Q:'$$DIVOK^PSOZDIR4(.PSOSITE,TY,PSRXN,PSFILL)
;
N DIRUT,PSOIENS,PSOSITEI,PSOVAL,IENS
;
S PSOVAL=0 ; Default return value to false (failed screen by division)
;
I XREF="AL" D ; An original or a refill, depending upon value RX1
. ;
. I RX1=0 D ; Original RX based upon an 'AL' type of XREF
. . ;
. . ; DIVISION (#20) [RP59'] of PRESCRIPTION file (#52)
. . S IENS=RX0_","
. . S PSOSITEI=$$GET1^DIQ(52,IENS,20,"I") Q:$G(DIERR)
. ;
. I RX1>0 D ; Refilled RX based upon an 'AL' type of XREF
. . ;
. . ; DIVISION (#8) [RP59'] of REFILL multiple (#52.1)
. . S IENS=RX1_","_RX0_","
. . S PSOSITEI=$$GET1^DIQ(52.1,IENS,8,"I") Q:$G(DIERR)
. ;
. I $D(INARRAY(PSOSITEI)) S PSOVAL=1 ; Selected DIVISION found
;
I XREF="AM" D ; Partial RX based upon 'AM' type of XREF
. ;
. ; DIVISION (#.09) [RP59'] of PARTIAL DATA multiple (#52.2)
. S IENS=RX1_","_RX0_","
. S PSOSITEI=$$GET1^DIQ(52.2,IENS,.09,"I") Q:$G(DIERR)
. ;
. I $D(INARRAY(PSOSITEI)) S PSOVAL=1 ; Selected DIVISION found
;
Q PSOVAL
DIR() Q "%,DIR,DIRUT,DTOUT,DUOUT,I,X,Y" ;............... ^DIR
Q
;
GETSITE(PSORTN) ; Prompt for Outpatient Site (or Division)
;
; Output:
; PSOSSITE(IENof59)=NAME (of OUTPATIENT SITE file #59)
; PSOFLGQ = 1 if user enters '^' or no active Outpatient Site found
;
N PSODEF,PSODTINAC,PSOIEN59,PSOIENS,PSOFLGQ,PSOMAX,PROMPT,PSOSITNM,PSOSCNT
;
; Set default to user's previous response; or '1-2'
; if no previous response
;
S PSODEF=$G(^DISV(DUZ,PSORTN,"PSOSITE"),"1-2")
;
; Loop through OUTPATIENT SITE file (#59) entries
; and bypass any inactive entries. Build a prompt array to be used
; as input to the FM DIR API call and display prompt text and any
; active OUTPATIENT SITE entries for user selection.
;
S (PSOSCNT,PSOIEN59)=0
F S PSOIEN59=$O(^PS(59,PSOIEN59)) Q:'PSOIEN59 D ;
. S PSOIENS=PSOIEN59_"," ; IEN String for FM Database Server calls
. S PSODTINAC=$$GET1^DIQ(59,PSOIENS,2004,"I") Q:$G(DIERR) ; INACTIVE DATE
. I PSODTINAC,PSODTINAC'>DT Q ; Quit if currently inactive
. S PSOSITNM=$$GET1^DIQ(59,PSOIENS,.01) Q:$G(DIERR) ; NAME of SITE
. Q:PSOSITNM="" ; Quit it NAME of OUTPATIENT SITE is null
. S PSOSCNT=PSOSCNT+1 ; Increment count of active Outpatient Sites
. I PSOSCNT=1 D ;. Display prompt text before 1st active Outpatient Site
. . W !
. . W !,"For RXs written at OUTPATIENT SITEs: (Example 1,3 or 1-5)"
. S PROMPT(PSOSCNT)=PSOIEN59_"^"_PSOSITNM ; Input array to FM DIR API
. W !?3,$J(PSOSCNT,2),") ",PSOSITNM ;.. Display choice number & site
;
I 'PSOSCNT S PSOFLGQ=1 Q ; If no active sites, return PSOFLGQ = 1
;
; Refresh output array, prompt user using FM DIR List or Range API
; and save user's choice in ^DISV global for future default
;
KILL PSOSSITE ; Refresh output array
W ! D REFSITE(.PROMPT,.PSOSSITE,PSOSCNT,$G(DEF),1)
S:PSOMAX'["^" ^DISV(DUZ,PSORTN,"PSOSSITE")=PSOMAX
;
Q
REFSITE(PSOINPUT,PSOOUTPT,PSOMAX,PSODEF,PSORETRN) ; Prompt for range or list of displayed items
; PSOINPUT - Array of displayed menu items in the format:
; PSOINPUT(PSONUM)=PSOIEN_"^"_PSOVALU
; PSOOUTPT - Array of user selected items in the format:
; PSOOUTPT(PSOIEN)=PSOVALU
; PSOMAX ; User's response
; PSOMAX - Maximum number of items displayed
; PSODEF - Default answer (optional)
; PSORETRN - If 1 the users response will be returned in var. PSOMAX
; (optional)
;
N @($$DIR^PSODIR4())
N PSOI,PSOIEN,PSONUM,PSOVALU
S DIR(0)="LAO^1:"_PSOMAX ;...User may select list or range
S DIR("A")="Select NUMBER(s): " ;...Prompt text
I PSODEF]"" S DIR("B")=PSODEF
D ^DIR ;...Prompt user IA #10026
S PSOOUTPT=X
I $G(PSORETRN)=1 S PSOMAX=X
I "^"[X S PSOFLGQ=1 Q
;-> Process user's list of choices. Example Y="1,3,5,6,"
S PSONUM=""
F PSOI=1:1 S PSONUM=$P(Y,",",PSOI) Q:'PSONUM D ;
. S PSOIEN=$P(PSOINPUT(PSONUM),U,1),PSOVALU=$P(PSOINPUT(PSONUM),U,2)
. S PSOOUTPT(PSOIEN)=PSOVALU
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODIR4 11048 printed Dec 13, 2024@02:27:05 Page 2
PSODIR4 ;EPIP/RTW - Outpatient Site High Cost Related Calls ; 3/30/18 11:30am
+1 ;;7.0;OUTPATIENT PHARMACY;**452**;Dec 1997;Build 56
+2 ;------------------------------------------------------------------
+3 ; ICR# TYPE DESCRIPTION
+4 ;----- --------- --------------------------------------------
+5 ; 2056 Supported $$GET1^DIQ
+6 ;10026 Supported ^DIR
+7 ;------------------------------------------------------------------
OPTSITE(PSOTRGET,PSORTN,PSOSCREN) ; Prompt for Outpatient Site when the host site
+1 ; has multiple OUTPATIENT SITE file (#59) entries.
+2 ;
+3 ; Input:
+4 ; PSOTRGET ; Required ; Name of output variable/array, passed by
+5 ; reference.
+6 ; PSORTN ; Required ; Name of calling routine, usually $T(+0)
+7 ; PSOSCREN ; Optional ;
+8 ; 0 ; By default, no screening of entries will take place
+9 ; 1 ; Optionally, only active OUTPATIENT SITE entries
+10 ; Output: ;
+11 ; The passed name of the PSOTRGET will be used in all output as
+12 ; follows:
+13 ; PSOTRGET=User's response from FM DIR API prompt
+14 ; PSOTRGET(PSOIEN59)=NAME (of OUTPATIENT SITE file (#59) entry)
+15 ; PSOTRGET("PSOSCNT")=Number of selected OUTPATIENT SITE entries
+16 ; - or -
+17 ; PSOTRGET="^" ; If an error occurs, user times out or enters '^'
+18 ;
+19 ; Intended usage:
+20 ; List the host computer's OUTPATIENT SITE entries allowing
+21 ; the user to select any combination of those entries, for example
+22 ; if there are 5 active OUTPATIENT SITEs, the user can select one
+23 ; of the following: 1 1-3 1,2,5
+24 ;
+25 ; Example calls:
+26 ; 1. Allow both active and/or inactive entries to be selected:
+27 ; D OPTSITE^PSODIR4(.PSOTRGET,$T(+0)) G:PSOTRGET="^" EXIT
+28 ; 2. Allow only active OUTPATIENT SITE entries to be selected:
+29 ; D OPTSITE^PSODIR4(.PSOTRGET,$T(+0),1) G:PSOTRGET="^" EXIT
+30 ;
+31 ; Start with fresh output
KILL PSOTRGET
+32 ; Set optional screen to zero (avoid screening)
SET PSOSCREN=$GET(PSOSCREN,0)
+33 ;
+34 ; Place selectable OUTPATIENT SITE entries in array:
+35 ; PSOINPUT(Sequential#)=PSOIEN59_"^"_PSOSITNM
+36 ;
+37 NEW PSOSCNT,PSODTINAC,PSOIEN59,PSOINPUT,PSOEXIT,PSOSITNM
+38 ; PSOSCNT=Count the number of selectable OUTPATIENT SITEs
SET (PSOSCNT,PSOIEN59)=0
+39 ;
FOR
SET PSOIEN59=$ORDER(^PS(59,PSOIEN59))
if 'PSOIEN59
QUIT
Begin DoDot:1
+40 ; OUTPATIENT SITE NAME (#.01)
SET PSOSITNM=$$GET1^DIQ(59,PSOIEN59,.01)
+41 ; Keep only active sites
IF PSOSCREN=1
Begin DoDot:2
+42 SET PSOEXIT=0
+43 ; INACTIVE DATE (#2004)
SET PSODTINAC=$$GET1^DIQ(59,PSOIEN59,2004,"I")
+44 ;. Bypass inactive site
IF PSODTINAC
IF PSODTINAC'>DT
SET PSOEXIT="^"
QUIT
End DoDot:2
if PSOEXIT="^"
QUIT
+45 SET PSOSCNT=PSOSCNT+1
+46 SET PSOINPUT(PSOSCNT)=PSOIEN59_"^"_PSOSITNM
End DoDot:1
+47 ;
+48 ; When PSOSCNT of entries = 1, no need to prompt user
IF PSOSCNT=1
Begin DoDot:1
+49 SET PSOIEN59=$PIECE(PSOINPUT(PSOSCNT),U,1)
SET PSOSITNM=$PIECE(PSOINPUT(PSOSCNT),U,2)
+50 ; PSOTRGET is the single Outpatient Site
SET PSOTRGET(PSOIEN59)=PSOSITNM
+51 SET PSOTRGET("PSOSCNT")=1
SET PSOTRGET=""
End DoDot:1
QUIT
+52 ; No active OUTPATIENT SITE entries found
IF PSOSCNT=0
SET PSOTRGET="^"
QUIT
+53 ;
+54 ; Display the selectable OUTPATIENT SITE entries from the INPUT
+55 ; array previously created above.
+56 ;
+57 WRITE !
+58 WRITE !,"For RXs written at OUTPATIENT SITE(s): (Example 1,3 or 1-5)"
+59 ;
+60 NEW PSOSCNT,PSOIEN59,PSOMAX
+61 ; MAX=Count the number of selectable OUTPATIENT SITEs
SET (PSOSCNT,PSOMAX)=0
+62 ;
FOR
SET PSOSCNT=$ORDER(PSOINPUT(PSOSCNT))
if 'PSOSCNT
QUIT
Begin DoDot:1
+63 SET PSOIEN59=$PIECE(PSOINPUT(PSOSCNT),U)
SET PSOSITNM=$PIECE(PSOINPUT(PSOSCNT),U,2)
+64 WRITE !?3,$JUSTIFY(PSOSCNT,2),") ",PSOSITNM
+65 SET PSOMAX=PSOMAX+1
End DoDot:1
+66 ;
+67 ; Prepare for DIR (list or range) API to prompt for selected sites
+68 ;
+69 ; DIR API variables
NEW %,DA,DIR,DIRUT,DTOUT,DUOUT,I,X,Y
+70 NEW PSODEF
+71 ;
+72 ;DIR prompt text
SET DIR("A")="Select NUMBER(s): "
+73 SET PSODEF=$GET(^DISV(DUZ,PSORTN,"PSOSITE"),"1-"_PSOMAX)
if PSODEF]""
SET DIR("B")=PSODEF
+74 ; Note: Previously defaulted site might be inactivated, making the
+75 ; previous default range too large
+76 IF $PIECE(DIR("B"),"-",2)>PSOMAX
SET DIR("B")="1-"_PSOMAX
+77 ;
+78 ; DIR(0) notes
+79 ; L=List or range format A=Nothing can be appended to DIC("A")
+80 ; O=User response is prompt is optional
+81 ; Select from 1 to MAXimum selectable range
+82 ; User may select list or range from 1 to PSOMAX
SET DIR(0)="LAO^1:"_PSOMAX
+83 ;
+84 DO ^DIR
+85 ;
+86 ; User time out at DIR prompt
IF $GET(DTOUT)
SET PSOTRGET="^"
QUIT
+87 ;User up-arrow out at DIR prompt
SET PSOTRGET=X
IF PSOTRGET["^"
SET PSOTRGET="^"
QUIT
+88 ;
+89 ; Build output PSOTRGET(PSOIEN59)=PSOSITNM from the comma delimited
+90 ; output varible Y of the FM DIR API. Example DIR output: Y="1,3,5,"
+91 ;
+92 NEW PSOIEN59,PCE,SUB
+93 ;
FOR PCE=1:1
SET SUB=$PIECE(Y,",",PCE)
if 'SUB
QUIT
Begin DoDot:1
+94 SET PSOIEN59=$PIECE(PSOINPUT(SUB),U,1)
SET PSOSITNM=$PIECE(PSOINPUT(SUB),U,2)
+95 SET PSOTRGET(PSOIEN59)=PSOSITNM
End DoDot:1
+96 ; Number of selected PSOTRGET entries
SET PSOTRGET("PSOSCNT")=$LENGTH(Y,",")-1
+97 ;
+98 ; Next default
if PSOTRGET'["^"
SET ^DISV(DUZ,PSORTN,"PSOSITE")=PSOTRGET
+99 ;
+100 QUIT
DIVOK(INARRAY,XREF,RX0,RX1) ; Return: 1 if the division of the RX is OK
+1 ; 0 if the division does not match a specified input selection
+2 ;
+3 ; Assumptions:
+4 ; This call was designed to work with an Original RX, a Refilled
+5 ; RX, or a Partial RX.
+6 ; Cross References potentially utilized by calling routines
+7 ; Original RX: ^PSRX("AL",Released_Dt,RX0,0)=""
+8 ; Refilled RX: ^PSRX("AL",Released_Dt,RX0,RX1)=""
+9 ; Partial RX: ^PSRX("AM",Released_Dt,RX0,RX1)=""
+10 ; Input:
+11 ; INARRAY ; Required ; Usually as the result from a previous
+12 ; execution of the above companion call OPTSITE^PSOZDIR4
+13 ; INARRAY(PSOIEN)=VALUE ; Example: INARRAY(1)="JOHN COCHRAN VAMC"
+14 ; INARRAY("B",VALUE,PSOIEN)="" ; INARRAY("B","JOHN COCHRAN VAMC",1)=""
+15 ; XREF ; Required ; Type of x-ref, where
+16 ; 'AL' ; Indicates a either an original RX when RX1=0
+17 ; Indicates a refilled (multiple) RX when RX1>0
+18 ; 'AM' ; Indicates a partial (multiple) RX
+19 ; Note: See routine PSOSCT10 as an example, used by the
+20 ; option High Cost Rx Report [PSO HI COST].
+21 ; RX0 ; Required ; IEN of PRESCRIPTION file #52 entry
+22 ; RX1 ; Required ; IEN1 of Refill or a Partial RX multiple entry.
+23 ; Output:
+24 ; This extrinsic functions returns 1 (true) or 0 (false)
+25 ; Intended usage:
+26 ; This purpose of this API is to screen a particular RX for report
+27 ; inclusion or exclusion, that is, if the RX was dispensed at a
+28 ; previously selected Outpatient Site it should be included. In
+29 ; this, the extrinsic function will return a one (1). If the RX
+30 ; was not dispensed at a selected Outpatient Site, it should be
+31 ; excluded and the extrinsic function will return a zero (0).
+32 ; Althought this API can be used independently, this entry point
+33 ; was written as a companion call to be utilized after calling the
+34 ; OPTSITE^PSOZDIR4 API.
+35 ; Example call:
+36 ; ; Prompt for which Outptient Site(s) to include
+37 ; D OPTSITE^PSOZDIR4(.PSOSITE,$T(+0)) G:PSOSITE="^" EXIT
+38 ; ; When looping thru entries in file (#52), screen
+39 ; ; the RX to only include a selected Outpatient Site.
+40 ; Q:'$$DIVOK^PSOZDIR4(.PSOSITE,TY,PSRXN,PSFILL)
+41 ;
+42 NEW DIRUT,PSOIENS,PSOSITEI,PSOVAL,IENS
+43 ;
+44 ; Default return value to false (failed screen by division)
SET PSOVAL=0
+45 ;
+46 ; An original or a refill, depending upon value RX1
IF XREF="AL"
Begin DoDot:1
+47 ;
+48 ; Original RX based upon an 'AL' type of XREF
IF RX1=0
Begin DoDot:2
+49 ;
+50 ; DIVISION (#20) [RP59'] of PRESCRIPTION file (#52)
+51 SET IENS=RX0_","
+52 SET PSOSITEI=$$GET1^DIQ(52,IENS,20,"I")
if $GET(DIERR)
QUIT
End DoDot:2
+53 ;
+54 ; Refilled RX based upon an 'AL' type of XREF
IF RX1>0
Begin DoDot:2
+55 ;
+56 ; DIVISION (#8) [RP59'] of REFILL multiple (#52.1)
+57 SET IENS=RX1_","_RX0_","
+58 SET PSOSITEI=$$GET1^DIQ(52.1,IENS,8,"I")
if $GET(DIERR)
QUIT
End DoDot:2
+59 ;
+60 ; Selected DIVISION found
IF $DATA(INARRAY(PSOSITEI))
SET PSOVAL=1
End DoDot:1
+61 ;
+62 ; Partial RX based upon 'AM' type of XREF
IF XREF="AM"
Begin DoDot:1
+63 ;
+64 ; DIVISION (#.09) [RP59'] of PARTIAL DATA multiple (#52.2)
+65 SET IENS=RX1_","_RX0_","
+66 SET PSOSITEI=$$GET1^DIQ(52.2,IENS,.09,"I")
if $GET(DIERR)
QUIT
+67 ;
+68 ; Selected DIVISION found
IF $DATA(INARRAY(PSOSITEI))
SET PSOVAL=1
End DoDot:1
+69 ;
+70 QUIT PSOVAL
DIR() ;............... ^DIR
QUIT "%,DIR,DIRUT,DTOUT,DUOUT,I,X,Y"
+1 QUIT
+2 ;
GETSITE(PSORTN) ; Prompt for Outpatient Site (or Division)
+1 ;
+2 ; Output:
+3 ; PSOSSITE(IENof59)=NAME (of OUTPATIENT SITE file #59)
+4 ; PSOFLGQ = 1 if user enters '^' or no active Outpatient Site found
+5 ;
+6 NEW PSODEF,PSODTINAC,PSOIEN59,PSOIENS,PSOFLGQ,PSOMAX,PROMPT,PSOSITNM,PSOSCNT
+7 ;
+8 ; Set default to user's previous response; or '1-2'
+9 ; if no previous response
+10 ;
+11 SET PSODEF=$GET(^DISV(DUZ,PSORTN,"PSOSITE"),"1-2")
+12 ;
+13 ; Loop through OUTPATIENT SITE file (#59) entries
+14 ; and bypass any inactive entries. Build a prompt array to be used
+15 ; as input to the FM DIR API call and display prompt text and any
+16 ; active OUTPATIENT SITE entries for user selection.
+17 ;
+18 SET (PSOSCNT,PSOIEN59)=0
+19 ;
FOR
SET PSOIEN59=$ORDER(^PS(59,PSOIEN59))
if 'PSOIEN59
QUIT
Begin DoDot:1
+20 ; IEN String for FM Database Server calls
SET PSOIENS=PSOIEN59_","
+21 ; INACTIVE DATE
SET PSODTINAC=$$GET1^DIQ(59,PSOIENS,2004,"I")
if $GET(DIERR)
QUIT
+22 ; Quit if currently inactive
IF PSODTINAC
IF PSODTINAC'>DT
QUIT
+23 ; NAME of SITE
SET PSOSITNM=$$GET1^DIQ(59,PSOIENS,.01)
if $GET(DIERR)
QUIT
+24 ; Quit it NAME of OUTPATIENT SITE is null
if PSOSITNM=""
QUIT
+25 ; Increment count of active Outpatient Sites
SET PSOSCNT=PSOSCNT+1
+26 ;. Display prompt text before 1st active Outpatient Site
IF PSOSCNT=1
Begin DoDot:2
+27 WRITE !
+28 WRITE !,"For RXs written at OUTPATIENT SITEs: (Example 1,3 or 1-5)"
End DoDot:2
+29 ; Input array to FM DIR API
SET PROMPT(PSOSCNT)=PSOIEN59_"^"_PSOSITNM
+30 ;.. Display choice number & site
WRITE !?3,$JUSTIFY(PSOSCNT,2),") ",PSOSITNM
End DoDot:1
+31 ;
+32 ; If no active sites, return PSOFLGQ = 1
IF 'PSOSCNT
SET PSOFLGQ=1
QUIT
+33 ;
+34 ; Refresh output array, prompt user using FM DIR List or Range API
+35 ; and save user's choice in ^DISV global for future default
+36 ;
+37 ; Refresh output array
KILL PSOSSITE
+38 WRITE !
DO REFSITE(.PROMPT,.PSOSSITE,PSOSCNT,$GET(DEF),1)
+39 if PSOMAX'["^"
SET ^DISV(DUZ,PSORTN,"PSOSSITE")=PSOMAX
+40 ;
+41 QUIT
REFSITE(PSOINPUT,PSOOUTPT,PSOMAX,PSODEF,PSORETRN) ; Prompt for range or list of displayed items
+1 ; PSOINPUT - Array of displayed menu items in the format:
+2 ; PSOINPUT(PSONUM)=PSOIEN_"^"_PSOVALU
+3 ; PSOOUTPT - Array of user selected items in the format:
+4 ; PSOOUTPT(PSOIEN)=PSOVALU
+5 ; PSOMAX ; User's response
+6 ; PSOMAX - Maximum number of items displayed
+7 ; PSODEF - Default answer (optional)
+8 ; PSORETRN - If 1 the users response will be returned in var. PSOMAX
+9 ; (optional)
+10 ;
+11 NEW @($$DIR^PSODIR4())
+12 NEW PSOI,PSOIEN,PSONUM,PSOVALU
+13 ;...User may select list or range
SET DIR(0)="LAO^1:"_PSOMAX
+14 ;...Prompt text
SET DIR("A")="Select NUMBER(s): "
+15 IF PSODEF]""
SET DIR("B")=PSODEF
+16 ;...Prompt user IA #10026
DO ^DIR
+17 SET PSOOUTPT=X
+18 IF $GET(PSORETRN)=1
SET PSOMAX=X
+19 IF "^"[X
SET PSOFLGQ=1
QUIT
+20 ;-> Process user's list of choices. Example Y="1,3,5,6,"
+21 SET PSONUM=""
+22 ;
FOR PSOI=1:1
SET PSONUM=$PIECE(Y,",",PSOI)
if 'PSONUM
QUIT
Begin DoDot:1
+23 SET PSOIEN=$PIECE(PSOINPUT(PSONUM),U,1)
SET PSOVALU=$PIECE(PSOINPUT(PSONUM),U,2)
+24 SET PSOOUTPT(PSOIEN)=PSOVALU
End DoDot:1
+25 ;
+26 QUIT
