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

ABSPOS6C.m

Go to the documentation of this file. 
  1. ABSPOS6C ; IHS/FCS/DRS - continuation of ABSPOS6* ; 
  1.  ;;1.0;PHARMACY POINT OF SALE;**32**;JUN 21, 2001;Build 38
  1.  Q
  1. DEFTIME() Q .0015 ; fifteen minutes is the default default
  1. UPDFREQ() Q 15 ; every fifteen seconds is the usual case
  1. NEW ; Data entry screen - protocol ABSP P1 NEW CLAIMS
  1.  D FULL^VALM1 W:$D(IOF) @IOF
  1.  D ^ABSPOSI
  1.  D TERM^VALM0 ; not documented!
  1.  S VALMBCK="R" ; is this in here twice for a reason?
  1.  N NODISPLY S NODISPLY=1 D UPD^ABSPOS6A ; update, but don't display!
  1.  ;   when you QUIT with VALMBCK="R", the repainting will take care of it
  1.  S VALMBCK="R"
  1.  Q
  1. MYPARAMS ;EP - from ABSPOS6A
  1.  S ^TMP("ABSPOS",$J,"USER")=$S($D(USER):USER,$G(DUZ):DUZ,1:0)
  1.  S ^TMP("ABSPOS",$J,"TIME")=$S($D(TIME):TIME,1:$$DEFTIME) ; time window
  1.  S ^TMP("ABSPOS",$J,"FREQ")=$$UPDFREQ ; frequency of continuous updates
  1.  S ^TMP("ABSPOS",$J,"LAST UPDATE")=""
  1.  S ^TMP("ABSPOS",$J,"PATIENT")=0 ; all patients
  1.  S ^TMP("ABSPOS",$J,"PATIENT TIME")=30 ; # of days
  1.  S ^TMP("ABSPOS",$J,"MAX LINES")=1000 ; max lines on display
  1.  S DISP="^TMP(""ABSPOS"",$J,""DISP"")"
  1.  S DISPLINE="^TMP(""ABSPOS"",$J,""DISPLINE"")"
  1.  S DISPIDX="^TMP(""ABSPOS"",$J,""VALM"",""IDX"")"
  1.  S DISPHIST="^TMP(""ABSPOS"",$J,""HIST"")"
  1.  ;
  1.  ; Right now:  always display prescription detail.
  1.  ; Detail: If = 0, default is to not display any prescription detail.
  1.  ;    If >0, default is:
  1.  ;  display prescrip detail if pat has at least this many prescriptions
  1.  ;     so if it's =1, we always show prescription line item detail
  1.  ;  don't display detail if pat has < this many prescripts
  1.  ;
  1.  S ^TMP("ABSPOS",$J,"DETAIL")=1 ; do we do prescription detail?
  1.  ;
  1.  ; ^TMP("ABSPOS",$J,"DISP",...
  1.  ;  ,PATNAME)    =line #^sum statuses^datetime last chg^count prescs
  1.  ;    ^#rejected^#otherFails^#paid
  1.  ;  ,PATNAME,RXI)=line #^status      ^datetime last chg
  1.  ;    Note:  status 99 is stored here as 100, as in 100% done
  1.  ;
  1.  ; ^TMP("ABSPOS",$J,"DISPLINE")=how many lines of items
  1.  ; ^TMP("ABSPOS",$J,"DISPLINE",n)=patname or patname^rxi on this line
  1.  ;
  1.  ; ^TMP("ABSPOS",$J,"DISMISS",patname)=time
  1.  ; ^TMP("ABSPOS",$J,"DISMISS",patname,rxi)=time
  1.  ;
  1.  ;  Dismiss any mention of this patient until the given time.
  1.  ;  If a patient is dismissed, so are all of his prescriptions.
  1.  ;  But if a prescription has activity, the patient and that
  1.  ;  active prescription will appear again.
  1.  ;
  1.  S DISMISS="^TMP(""ABSPOS"",$J,""DISMISS"")"
  1.  ;
  1.  ;^TMP("ABSPOS",$J,"VALM",...) is the array we tell listman to use.
  1.  ;^TMP("ABSPOS",$J,"VALM","IDX",LINE,PATIEN) for a patient line
  1.  Q
  1. HDR ;EP - from ABSPOS6A ; -- header code
  1.  N USER,ONEPAT,%
  1.  S USER=^TMP("ABSPOS",$J,"USER")
  1.  S ONEPAT=^TMP("ABSPOS",$J,"PATIENT")
  1.  I USER S %="Transmitted by "_$P($G(^VA(200,USER,0)),U)
  1.  E  D
  1.  . S %="All prescriptions"
  1.  . I ONEPAT S %=%_" for patient "_$P(^DPT(ONEPAT,0),U)
  1.  S VALMHDR(1)=%
  1.  S VALMHDR(2)="With activity in the past"
  1.  S XQORM("B")="UC" ; the default is Update Continuously
  1.  S XQORM("B")="UD" ; but we'd like to do U1 continuously from top lvl
  1.  ; S DTIME=10 ; can't set this time out (wanted to do it to default a continuous update, but:  it affects all reads, so you need to always undo/redo it, and, if first read times out, List Mgr quits on you
  1.  N T,X S X=""
  1.  I ONEPAT S T=^TMP("ABSPOS",$J,"PATIENT TIME")
  1.  E  S T=$G(^TMP("ABSPOS",$J,"TIME"))
  1.  I 'T S T=$$DEFTIME
  1.  I $P(T,".") S X=" "_$P(T,".")_" da"
  1.  S T=$P(T,".",2)_"000000"
  1.  I $E(T,1,2) S X=X_" "_+$E(T,1,2)_" hr"
  1.  I $E(T,3,4) S X=X_" "_+$E(T,3,4)_" min"
  1.  I $E(T,5,6) S X=X_" "_+$E(T,5,6)_" sec"
  1.  S VALMHDR(2)=VALMHDR(2)_X
  1.  Q
  1. ONEPAT() ;EP - from ABSPOS6B 
  1.  ; overflow from ABSPOS - extra date & time info printed in onepat mode
  1.  ; POS time and FILL time
  1.  ;start with kludgey var name machinations (sigh)
  1.  N IEN59 S IEN59=RXI N RXI S RXI=$P(^ABSPT(IEN59,1),U,11)
  1.  N POS S POS=$P(^ABSPT(IEN59,0),U,8)
  1.  N RXR S RXR=$P(^ABSPT(IEN59,1),U)
  1.  ;IHS/OIT/SCR 06/05/09 START CHANGES pre-patch 32 to avoid undefined when RXI AND RXR are ""
  1.  ;N FILL I RXR S FILL=$P($G(^PSRX(RXI,1,RXR,0)),U)
  1.  ;E  S FILL=$P($G(^PSRX(RXI,2)),U,2)
  1.  N FILL
  1.  S FILL=""
  1.  I (RXR&RXI>0) S FILL=$P($G(^PSRX(RXI,1,RXR,0)),U)
  1.  I ('RXR&RXI>0) S FILL=$P($G(^PSRX(RXI,2)),U,2)
  1.  ;IHS/OIT/SCR 06/05/09 END CHANGES pre-patch 32
  1.  N Y S Y=POS D DATEHH S POS=Y
  1.  S Y=FILL D DATEHH S FILL=Y
  1.  I $P(POS,"@")=$P(FILL,"@") D
  1.  . S $P(FILL,"@",1)="" ; don't duplic date
  1.  . I $P(FILL,"@",2)="" S FILL=""
  1.  I FILL="" Q POS
  1.  Q POS_", FILL "_FILL
  1. DATEHH ; given Y, format it and reset it  
  1.  I 'Y S Y="?" Q
  1.  X ^DD("DD") S Y=$P(Y,":",1,2)
  1.  I $P($P(Y,"@"),",",2)-1700-$E(DT,1,3)=0 S Y=$P(Y,",")_"@"_$P(Y,"@",2)
  1.  Q