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

ABSPOSID.m

Go to the documentation of this file. 
  1. ABSPOSID ; IHS/FCS/DRS - the fill date field ;   [ 09/12/2002  10:11 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,10**;JUN 21, 2001;Build 38
  1.  ;
  1.  ; This should be used for prescriptions (and postage) only,
  1.  ; not charges associated with a visit.  It's tied to the prescription
  1.  ; file.  Besides, a visit lookup has already figured out the date,
  1.  ; implicitly, just by having chosen a visit.
  1.  ;
  1.  ; At the Fill Date field, the user may type:
  1.  ;   An exact date, if you know the exact date of the refill.
  1.  ;   FIND   to see a list of refill dates and then type it in.
  1.  ;
  1.  ; Unlike the Prescription field and ABSPOSI1,
  1.  ; the EFFECTS here are quite simple and are handled from 
  1.  ; inside the VALID logic.
  1.  ;----------------------------------------------------------------------
  1.  ;IHS/SD/lwj 03/10/04 patch 10
  1.  ; Routine adjusted to call ABSPFUNC to retrieve
  1.  ; the Prescription Refill NDC value.  At some
  1.  ; point the call needs to be modified to call APSPFUNC.
  1.  ; See ABSPFUNC for details on why call was done.
  1.  ;----------------------------------------------------------------------
  1.  ;
  1.  Q
  1. VALID ; VALID is the Data Validation action for the field.
  1.  ; It may cause more dialogue.
  1.  ; It might reset X and DDSEXT.  (stored in .06, DATE DISP)
  1.  ; If it does this, and this RXR is different from the one
  1.  ; chosen in $$GET^DDSVAL(DIE,.DA,1.02), then other side effects
  1.  ; need to happen:  (EFFECTS, called from here in VALID, unlike 
  1.  ;  ABSPOSI1, where it's two separate steps)
  1.  ;   
  1.  ;D MSGWAIT("We are in VALID^"_$T(+0)_" with X="_$G(X)_", DDSEXT="_$G(DDSEXT))
  1.  N RXI S RXI=$$GET^DDSVAL(DIE,.DA,1.01,,"I") ; point to ^PSRX
  1.  N RXR,OLDRXR S OLDRXR=$$GET^DDSVAL(DIE,.DA,1.02) K RXR
  1.  D PROCESS(X) ; will set RXR or DDSERROR
  1.  I $D(RXR) D
  1.  . I RXR=OLDRXR D  ; no change, be sure original data is still in place
  1.  . . S (X,DDSEXT)=DDSOLD
  1.  . E  D  ; changed!
  1.  . . N Y S Y=$$FILL(RXI,RXR) ; update date displayed in this field
  1.  . . X ^DD("DD")
  1.  . . S (X,DDSEXT)=$P(Y,",")
  1.  . . D EFFECTS ; and carry out some side effects
  1.  E  D  ; no input; make sure original data is unchanged
  1.  . S (X,DDSEXT)=DDSOLD
  1.  ;D PUT^DDSVAL(DIE,.DA,.06,DDSEXT) ; why do we have to do this?
  1.  ; ^^ it doesn't work if you do it here.
  1.  ;  But we put it into the POST ACTION ON CHANGE
  1.  ;D MSGWAIT("On the way out, we have set X="_$G(X)_" and DDSEXT="_$G(DDSEXT))
  1.  Q
  1.  ;
  1.  ;
  1. PROCESS(X) ;  validate input and return transformed value 
  1.  ; Returns -1 if error and sets DDSERROR
  1.  ;D MSGWAIT("We are in PROCESS^"_$T(+0)_" with X="_$G(X))
  1.  K DDSERROR
  1. VAL1 I 0 ; ELSE each possibility:
  1.  E  I $$UPPER(X)=$E("FIND",1,$L(X)) D
  1.  . W @IOF
  1.  . W $$GET^DDSVAL(DIE,.DA,.04)
  1.  . W "   ",$$GET^DDSVAL(DIE,.DA,.05),!
  1.  . N X S X=$$LOOKUP
  1.  . I "^^"[X S DDSERROR=2
  1.  . S RXR=X
  1.  . D REFRESH^DDSUTL
  1.  E  D
  1.  . N %DT S %DT="P" D ^%DT ; giving Y
  1.  . I Y=-1 S DDSERROR=3 Q
  1.  . ; but it must be a valid fill/refill date for the prescription
  1.  . I Y=$P(^PSRX(RXI,2),U,2) S RXR=0 Q  ; Date of first fill
  1.  . I $D(^PSRX(RXI,1,"B",Y)) S RXR=$O(^PSRX(RXI,1,"B",Y,0)) Q
  1.  . S DDSERROR=4 Q  ; valid date, but not for this prescription
  1.  ;E  D  ; if it didn't hit any of the recognized cases:
  1.  ;. S X=-1,DDSERROR=999
  1.  I $G(DDSERROR) D HELP
  1.  Q
  1. FILL(RXI,RXR) ; return fill date, internal form
  1.  I '$G(RXR) Q $P(^PSRX(RXI,2),U,2)
  1.  Q $P(^PSRX(RXI,1,RXR,0),U)
  1. LOOKUP() ; Choosing which fill date you're processing for
  1.  ; Returns Pointer to refill, = 0 if first fill
  1.  ; Returns "" if no selection made
  1.  N RXI S RXI=$$GET^DDSVAL(DIE,.DA,1.01,,"I")
  1.  I '$O(^PSRX(RXI,1,0)) D  Q 0
  1.  . W "There are no refills.",!
  1.  F  D  Q:X]""
  1.  . S X=$$LOOK2() I X S X=0 Q  ; want to use first fill date
  1.  . S X=$$LOOK3()
  1.  . S:X=U X="" ; back up to $$LOOK2() again
  1.  S:X=U X="" ; backing out; no selection made
  1.  Q X
  1. LOOK2() ; Want to use the first fill date?
  1.  ; If yes, returns >0, = internal form of that date
  1.  ; If no, returns ""
  1.  ; If timeout or "^", returns "^"
  1.  N DDS ; so that ^DIR thinks it's outside Screenman
  1.  N PROMPT,DFLT,OPT,TIMEOUT,X,Y
  1.  S Y=$$FILL(RXI) X ^DD("DD")
  1.  S PROMPT="Use "_Y_", which was the first fill date"
  1.  S DFLT="NO",OPT=0,TIMEOUT=60
  1.  S X=$$YESNO^ABSPOSU3(PROMPT,DFLT,OPT,TIMEOUT)
  1.  Q $S(X:$$FILL(RXI),X=0:"",1:"^")
  1. LOOK3() ; selection from among all the refill dates
  1.  ; Returns "^" if none selected (timeout or ^)
  1.  ; Returns pointer to refill (NOTE! pointer, not date) otherwise
  1.  N DDS ; so that ^DIR thinks it's outside Screenman
  1.  N DIR,DA,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S DIR(0)="PA^PSRX("_RXI_",1,",DA(1)=RXI
  1.  S DIR("A")="Select which refill date: "
  1.  D LOOK31
  1.  D ^DIR
  1.  I $D(DIRUT) Q "^"
  1.  I 'Y Q "^"
  1.  Q +Y
  1. LOOK31 ; set up DIR("A",#)=several most recent refill dates
  1.  ; List them all - the most we've seen at Sitka is 12 refills
  1.  N Y,MAX,N,X,TOT S MAX=10,N=0,X="",TOT=$P(^PSRX(RXI,1,0),U,4)
  1.  S DIR("A",1)="Refill dates for this prescription include:"
  1.  S N=2,DIR("A",2)="" ; row # currently being filled
  1.  F  S X=$O(^PSRX(RXI,1,"B",X),-1) Q:X=""  D  Q:N=MAX
  1.  . S Y=X X ^DD("DD")
  1.  . I '$D(DIR("B")) S DIR("B")=Y ; default to most recent refill
  1.  . S Y=$E(Y_"    ",1,14)
  1.  . I $L(DIR("A",N))>65 S N=N+1,DIR("A",N)=""
  1.  . S DIR("A",N)=DIR("A",N)_Y
  1.  . ;I N+1=MAX,TOT>MAX S N=N+1,DIR("A",N)="And more.  Type ? for a complete list."
  1.  Q
  1. FULLSCRE ; adapted from FULL^VALM1
  1.  S IOTM=1,IOBM=IOSL W IOSC W @IOSTBM W IORC Q
  1. HELP ;
  1.  N AR,N S N=0
  1.  D HELP1("To choose a different refill,")
  1.  D HELP1("type the date of the refill here.")
  1.  D HELP1("Or, type F or FIND to get a lookup dialogue.")
  1.  D HLP^DDSUTL(.AR)
  1.  Q
  1. HELP1(X) S N=N+1,AR(N)=X Q
  1. MSGWAIT(X) ;EP - from ABSPOSI2,ABSPOSI8
  1.  N AR S AR(1)=X
  1.  ; ,AR(2)="$$EOP" 
  1.  D HLP^DDSUTL(.AR)
  1.  D HLP^DDSUTL("$$EOP")
  1.  Q
  1. EFFECTS ; side effects of putting a value in the Fill Date field
  1.  D PUT^DDSVAL(DIE,.DA,.06,DDSEXT) ; it doesn't seem to take, if here
  1.  ; so we put it in the POST ACTION ON CHANGE
  1.  ;
  1.  N NDC
  1.  ;IHS/SD/lwj 03/10/04 patch 10 nxt line rmkd out, new line added
  1.  ;I RXR S NDC=$P(^PSRX(RXI,1,RXR,0),U,13)
  1.  I RXR S NDC=$$NDCVAL^ABSPFUNC(RXI,RXR)  ;patch 10
  1.  E  S NDC=$P(^PSRX(RXI,2),U,7)
  1.  ;IHS/SD/lwj 03/10/04 patch 10 end change
  1.  I NDC]"" D PUT^DDSVAL(DIE,.DA,.03,NDC)
  1.  D PUT^DDSVAL(DIE,.DA,1.02,RXR)
  1.  D PUT^DDSVAL(DIE,.DA,1.06,$$VISIT(RXI,RXR),,"I")
  1.  Q
  1. MMMDD(Y) ;EP
  1.  X ^DD("DD") Q $P(Y,",")
  1. UPPER(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. VISIT(RXI,RXR)     ;
  1.  N VISIT
  1.  I $G(RXR) S VISIT=$P($G(^PSRX(RXI,1,RXR,999999911)),U)
  1.  E  S VISIT=$P($G(^PSRX(RXI,999999911)),U)
  1.  I VISIT S VISIT=$P($G(^AUPNVMED(VISIT,0)),U,3)
  1.  Q VISIT