Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSODIR4

PSODIR4.m

Go to the documentation of this file. 
  1. PSODIR4 ;EPIP/RTW - Outpatient Site High Cost Related Calls ; 3/30/18 11:30am
  1.  ;;7.0;OUTPATIENT PHARMACY;**452**;Dec 1997;Build 56
  1.  ;------------------------------------------------------------------
  1.  ; ICR#     TYPE    DESCRIPTION
  1.  ;-----  ---------  --------------------------------------------
  1.  ; 2056  Supported  $$GET1^DIQ
  1.  ;10026  Supported  ^DIR
  1.  ;------------------------------------------------------------------
  1. OPTSITE(PSOTRGET,PSORTN,PSOSCREN) ; Prompt for Outpatient Site when the host site
  1.  ; has multiple OUTPATIENT SITE file (#59) entries.
  1.  ;
  1.  ; Input:
  1.  ;   PSOTRGET ; Required ; Name of output variable/array, passed by
  1.  ;                       reference.
  1.  ;   PSORTN    ; Required ; Name of calling routine, usually $T(+0)
  1.  ;   PSOSCREN ; Optional ;
  1.  ;            0 ; By default, no screening of entries will take place
  1.  ;            1 ; Optionally, only active OUTPATIENT SITE entries
  1.  ; Output:  ;
  1.  ;   The passed name of the PSOTRGET will be used in all output as
  1.  ;   follows:
  1.  ;     PSOTRGET=User's response from FM DIR API prompt
  1.  ;     PSOTRGET(PSOIEN59)=NAME (of OUTPATIENT SITE file (#59) entry)
  1.  ;     PSOTRGET("PSOSCNT")=Number of selected OUTPATIENT SITE entries
  1.  ;                   - or -
  1.  ;     PSOTRGET="^" ; If an error occurs, user times out or enters '^'
  1.  ;
  1.  ; Intended usage:
  1.  ;   List the host computer's OUTPATIENT SITE entries allowing
  1.  ;   the user to select any combination of those entries, for example
  1.  ;   if there are 5 active OUTPATIENT SITEs, the user can select one
  1.  ;   of the following: 1  1-3  1,2,5
  1.  ;
  1.  ; Example calls:
  1.  ;   1. Allow both active and/or inactive entries to be selected:
  1.  ;      D OPTSITE^PSODIR4(.PSOTRGET,$T(+0)) G:PSOTRGET="^" EXIT
  1.  ;   2. Allow only active OUTPATIENT SITE entries to be selected:
  1.  ;      D OPTSITE^PSODIR4(.PSOTRGET,$T(+0),1) G:PSOTRGET="^" EXIT
  1.  ;
  1.  KILL PSOTRGET ; Start with fresh output
  1.  S PSOSCREN=$G(PSOSCREN,0) ; Set optional screen to zero (avoid screening)
  1.  ;
  1.  ; Place selectable  OUTPATIENT SITE entries in array:
  1.  ;   PSOINPUT(Sequential#)=PSOIEN59_"^"_PSOSITNM
  1.  ; 
  1.  N PSOSCNT,PSODTINAC,PSOIEN59,PSOINPUT,PSOEXIT,PSOSITNM
  1.  S (PSOSCNT,PSOIEN59)=0 ; PSOSCNT=Count the number of selectable OUTPATIENT SITEs
  1.  F  S PSOIEN59=$O(^PS(59,PSOIEN59)) Q:'PSOIEN59  D  ;
  1.  . S PSOSITNM=$$GET1^DIQ(59,PSOIEN59,.01) ; OUTPATIENT SITE NAME (#.01)
  1.  . I PSOSCREN=1 D  Q:PSOEXIT="^"  ; Keep only active sites
  1.  . . S PSOEXIT=0
  1.  . . S PSODTINAC=$$GET1^DIQ(59,PSOIEN59,2004,"I") ; INACTIVE DATE (#2004)
  1.  . . I PSODTINAC,PSODTINAC'>DT S PSOEXIT="^" Q  ;. Bypass inactive site
  1.  . S PSOSCNT=PSOSCNT+1
  1.  . S PSOINPUT(PSOSCNT)=PSOIEN59_"^"_PSOSITNM
  1.  ;
  1.  I PSOSCNT=1 D  Q  ; When PSOSCNT of entries = 1, no need to prompt user
  1.  . S PSOIEN59=$P(PSOINPUT(PSOSCNT),U,1),PSOSITNM=$P(PSOINPUT(PSOSCNT),U,2)
  1.  . S PSOTRGET(PSOIEN59)=PSOSITNM ; PSOTRGET is the single Outpatient Site
  1.  . S PSOTRGET("PSOSCNT")=1,PSOTRGET=""
  1.  I PSOSCNT=0 S PSOTRGET="^" Q  ; No active OUTPATIENT SITE entries found
  1.  ;
  1.  ; Display the selectable  OUTPATIENT SITE entries from the INPUT 
  1.  ; array previously created above.
  1.  ;
  1.  W !
  1.  W !,"For RXs written at OUTPATIENT SITE(s):  (Example 1,3 or 1-5)"
  1.  ;
  1.  N PSOSCNT,PSOIEN59,PSOMAX
  1.  S (PSOSCNT,PSOMAX)=0 ; MAX=Count the number of selectable OUTPATIENT SITEs
  1.  F  S PSOSCNT=$O(PSOINPUT(PSOSCNT)) Q:'PSOSCNT  D  ;
  1.  . S PSOIEN59=$P(PSOINPUT(PSOSCNT),U),PSOSITNM=$P(PSOINPUT(PSOSCNT),U,2)
  1.  . W !?3,$J(PSOSCNT,2),")  ",PSOSITNM
  1.  . S PSOMAX=PSOMAX+1
  1.  ;
  1.  ; Prepare for DIR (list or range) API to prompt for selected sites
  1.  ;
  1.  N %,DA,DIR,DIRUT,DTOUT,DUOUT,I,X,Y ; DIR API variables
  1.  N PSODEF
  1.  ;
  1.  S DIR("A")="Select NUMBER(s): " ;DIR prompt text
  1.  S PSODEF=$G(^DISV(DUZ,PSORTN,"PSOSITE"),"1-"_PSOMAX) S:PSODEF]"" DIR("B")=PSODEF
  1.  ; Note: Previously defaulted site might be inactivated, making the
  1.  ;       previous default range too large
  1.  I $P(DIR("B"),"-",2)>PSOMAX S DIR("B")="1-"_PSOMAX
  1.  ;
  1.  ; DIR(0) notes
  1.  ;  L=List or range format  A=Nothing can be appended to DIC("A")
  1.  ;                          O=User response is prompt is optional
  1.  ;  Select from 1 to MAXimum selectable range
  1.  S DIR(0)="LAO^1:"_PSOMAX ; User may select list or range from 1 to PSOMAX
  1.  ;
  1.  D ^DIR
  1.  ;
  1.  I $G(DTOUT) S PSOTRGET="^" Q  ; User time out at DIR prompt
  1.  S PSOTRGET=X I PSOTRGET["^" S PSOTRGET="^" Q  ;User up-arrow out at DIR prompt
  1.  ;
  1.  ; Build output PSOTRGET(PSOIEN59)=PSOSITNM from the comma delimited
  1.  ; output varible Y of the FM DIR API.  Example DIR output: Y="1,3,5,"
  1.  ;
  1.  N PSOIEN59,PCE,SUB
  1.  F PCE=1:1 S SUB=$P(Y,",",PCE) Q:'SUB  D  ;
  1.  . S PSOIEN59=$P(PSOINPUT(SUB),U,1),PSOSITNM=$P(PSOINPUT(SUB),U,2)
  1.  . S PSOTRGET(PSOIEN59)=PSOSITNM
  1.  S PSOTRGET("PSOSCNT")=$L(Y,",")-1 ; Number of selected PSOTRGET entries
  1.  ;
  1.  S:PSOTRGET'["^" ^DISV(DUZ,PSORTN,"PSOSITE")=PSOTRGET ; Next default
  1.  ;
  1.  Q
  1. 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
  1.  ;
  1.  ; Assumptions:
  1.  ;   This call was designed to work with an Original RX, a Refilled
  1.  ;   RX, or a Partial RX.
  1.  ; Cross References potentially utilized by calling routines
  1.  ;   Original RX: ^PSRX("AL",Released_Dt,RX0,0)=""
  1.  ;   Refilled RX: ^PSRX("AL",Released_Dt,RX0,RX1)=""
  1.  ;   Partial  RX: ^PSRX("AM",Released_Dt,RX0,RX1)=""
  1.  ; Input:
  1.  ;   INARRAY ; Required ; Usually as the result from a previous
  1.  ;             execution of the above companion call OPTSITE^PSOZDIR4
  1.  ;     INARRAY(PSOIEN)=VALUE ; Example: INARRAY(1)="JOHN COCHRAN VAMC"
  1.  ;     INARRAY("B",VALUE,PSOIEN)="" ; INARRAY("B","JOHN COCHRAN VAMC",1)=""
  1.  ;   XREF ; Required ; Type of x-ref, where
  1.  ;              'AL' ; Indicates a either an original RX when RX1=0
  1.  ;                     Indicates a refilled (multiple) RX when RX1>0
  1.  ;              'AM' ; Indicates a partial  (multiple) RX
  1.  ;          Note: See routine PSOSCT10 as an example, used by the
  1.  ;                option High Cost Rx Report [PSO HI COST].
  1.  ;   RX0  ; Required ; IEN of PRESCRIPTION file #52 entry
  1.  ;   RX1  ; Required ; IEN1 of Refill or a Partial RX multiple entry.
  1.  ; Output:
  1.  ;   This extrinsic functions returns 1 (true) or 0 (false)
  1.  ; Intended usage:
  1.  ;   This purpose of this API is to screen a particular RX for report
  1.  ;   inclusion or exclusion, that is, if the RX was dispensed at a
  1.  ;   previously selected Outpatient Site it should be included. In
  1.  ;   this, the extrinsic function will return a one (1).  If the RX
  1.  ;   was not dispensed at a selected Outpatient Site, it should be
  1.  ;   excluded and the extrinsic function will return a zero (0).
  1.  ;   Althought this API can be used independently, this entry point
  1.  ;   was written as a companion call to be utilized after calling the
  1.  ;   OPTSITE^PSOZDIR4 API.
  1.  ; Example call:
  1.  ;   ; Prompt for which Outptient Site(s) to include
  1.  ;   D OPTSITE^PSOZDIR4(.PSOSITE,$T(+0)) G:PSOSITE="^" EXIT
  1.  ;   ; When looping thru entries in file (#52), screen
  1.  ;   ; the RX to only include a selected Outpatient Site.
  1.  ;   Q:'$$DIVOK^PSOZDIR4(.PSOSITE,TY,PSRXN,PSFILL)
  1.  ;
  1.  N DIRUT,PSOIENS,PSOSITEI,PSOVAL,IENS
  1.  ;
  1.  S PSOVAL=0 ; Default return value to false (failed screen by division)
  1.  ;
  1.  I XREF="AL" D  ; An original or a refill, depending upon value RX1
  1.  . ;
  1.  . I RX1=0 D  ; Original RX based upon an 'AL' type of XREF
  1.  . . ;
  1.  . . ; DIVISION (#20) [RP59'] of PRESCRIPTION file (#52)
  1.  . . S IENS=RX0_","
  1.  . . S PSOSITEI=$$GET1^DIQ(52,IENS,20,"I") Q:$G(DIERR)
  1.  . ;
  1.  . I RX1>0 D  ; Refilled RX based upon an 'AL' type of XREF
  1.  . . ;
  1.  . . ; DIVISION (#8) [RP59'] of REFILL multiple (#52.1)
  1.  . . S IENS=RX1_","_RX0_","
  1.  . . S PSOSITEI=$$GET1^DIQ(52.1,IENS,8,"I") Q:$G(DIERR)
  1.  . ;
  1.  . I $D(INARRAY(PSOSITEI)) S PSOVAL=1 ; Selected DIVISION found
  1.  ;
  1.  I XREF="AM" D  ; Partial RX based upon 'AM' type of XREF
  1.  . ;
  1.  . ; DIVISION (#.09) [RP59'] of PARTIAL DATA multiple (#52.2)
  1.  . S IENS=RX1_","_RX0_","
  1.  . S PSOSITEI=$$GET1^DIQ(52.2,IENS,.09,"I") Q:$G(DIERR)
  1.  . ;
  1.  . I $D(INARRAY(PSOSITEI)) S PSOVAL=1 ; Selected DIVISION found
  1.  ;
  1.  Q PSOVAL
  1. DIR() Q "%,DIR,DIRUT,DTOUT,DUOUT,I,X,Y" ;............... ^DIR
  1.  Q
  1.  ;
  1. GETSITE(PSORTN) ; Prompt for Outpatient Site (or Division)
  1.  ;
  1.  ; Output:
  1.  ;     PSOSSITE(IENof59)=NAME (of OUTPATIENT SITE file #59)
  1.  ;     PSOFLGQ = 1 if user enters '^' or no active Outpatient Site found
  1.  ;
  1.  N PSODEF,PSODTINAC,PSOIEN59,PSOIENS,PSOFLGQ,PSOMAX,PROMPT,PSOSITNM,PSOSCNT
  1.  ;
  1.  ; Set default to user's previous response; or '1-2'
  1.  ; if no previous response
  1.  ;
  1.  S PSODEF=$G(^DISV(DUZ,PSORTN,"PSOSITE"),"1-2")
  1.  ;
  1.  ; Loop through OUTPATIENT SITE file (#59) entries
  1.  ; and bypass any inactive entries.  Build a prompt array to be used
  1.  ; as input to the FM DIR API call and display prompt text and any
  1.  ; active OUTPATIENT SITE entries for user selection.
  1.  ;
  1.  S (PSOSCNT,PSOIEN59)=0
  1.  F  S PSOIEN59=$O(^PS(59,PSOIEN59)) Q:'PSOIEN59  D  ;
  1.  . S PSOIENS=PSOIEN59_"," ; IEN String for FM Database Server calls
  1.  . S PSODTINAC=$$GET1^DIQ(59,PSOIENS,2004,"I") Q:$G(DIERR)  ; INACTIVE DATE
  1.  . I PSODTINAC,PSODTINAC'>DT Q  ; Quit if currently inactive
  1.  . S PSOSITNM=$$GET1^DIQ(59,PSOIENS,.01) Q:$G(DIERR)  ; NAME of SITE
  1.  . Q:PSOSITNM=""  ; Quit it NAME of OUTPATIENT SITE is null
  1.  . S PSOSCNT=PSOSCNT+1 ; Increment count of active Outpatient Sites
  1.  . I PSOSCNT=1 D  ;. Display prompt text before 1st active Outpatient Site
  1.  . . W !
  1.  . . W !,"For RXs written at OUTPATIENT SITEs:  (Example 1,3 or 1-5)"
  1.  . S PROMPT(PSOSCNT)=PSOIEN59_"^"_PSOSITNM ; Input array to FM DIR API
  1.  . W !?3,$J(PSOSCNT,2),")  ",PSOSITNM ;.. Display choice number & site
  1.  ;
  1.  I 'PSOSCNT S PSOFLGQ=1 Q  ; If no active sites, return PSOFLGQ = 1
  1.  ;
  1.  ; Refresh output array, prompt user using FM DIR List or Range API
  1.  ; and save user's choice in ^DISV global for future default
  1.  ;
  1.  KILL PSOSSITE ; Refresh output array
  1.  W ! D REFSITE(.PROMPT,.PSOSSITE,PSOSCNT,$G(DEF),1)
  1.  S:PSOMAX'["^" ^DISV(DUZ,PSORTN,"PSOSSITE")=PSOMAX
  1.  ;
  1.  Q
  1. REFSITE(PSOINPUT,PSOOUTPT,PSOMAX,PSODEF,PSORETRN) ; Prompt for range or list of displayed items
  1.  ; PSOINPUT  - Array of displayed menu items in the format:
  1.  ; PSOINPUT(PSONUM)=PSOIEN_"^"_PSOVALU
  1.  ; PSOOUTPT - Array of user selected items in the format:
  1.  ;    PSOOUTPT(PSOIEN)=PSOVALU
  1.  ; PSOMAX ; User's response
  1.  ; PSOMAX    - Maximum number of items displayed
  1.  ; PSODEF    - Default answer (optional)
  1.  ; PSORETRN - If 1 the users response will be returned in var. PSOMAX
  1.  ; (optional)
  1.  ;
  1.  N @($$DIR^PSODIR4())
  1.  N PSOI,PSOIEN,PSONUM,PSOVALU
  1.  S DIR(0)="LAO^1:"_PSOMAX ;...User may select list or range
  1.  S DIR("A")="Select NUMBER(s): " ;...Prompt text
  1.  I PSODEF]"" S DIR("B")=PSODEF
  1.  D ^DIR ;...Prompt user IA #10026
  1.  S PSOOUTPT=X
  1.  I $G(PSORETRN)=1 S PSOMAX=X
  1.  I "^"[X S PSOFLGQ=1 Q
  1.  ;-> Process user's list of choices.  Example Y="1,3,5,6,"
  1.  S PSONUM=""
  1.  F PSOI=1:1 S PSONUM=$P(Y,",",PSOI) Q:'PSONUM  D  ;
  1.  . S PSOIEN=$P(PSOINPUT(PSONUM),U,1),PSOVALU=$P(PSOINPUT(PSONUM),U,2)
  1.  . S PSOOUTPT(PSOIEN)=PSOVALU
  1.  ;
  1.  Q