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

ABSPOSIF.m

Go to the documentation of this file. 
  1. ABSPOSIF ; IHS/FCS/DRS - handle FIND command ;   [ 09/12/2002  10:11 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,46**;JUN 21, 2001;Build 38
  1.  ; "FIND" - when typed at Prescription field, here's what happens
  1.  Q
  1. TEST N RETVAL S RETVAL=$$RXFIND()
  1.  W ! D ZWRITE^ABSPOS("RETVAL")
  1.  Q
  1. RXFIND(PAT,TYPE,VISITIN) ;EP - from ABSPOSI1
  1.  ;lookup prescription - return RXI^RXR
  1.  ; If you don't send the patient or the visitIEN, a lookup is done. 
  1.  ; TYPE = 1 looking for a prescription - return RXI^RXR
  1.  ; TYPE = 2 looking for a visit - return VISITIEN
  1.  ; TYPE = 3 (default)  don't know which; ask.
  1.  ;     Which one is returned?  $L(returned value,U)=1 or 2 tells you
  1.  ; Returns False if no selection made.
  1.  ;
  1.  ; We lookup the patient first, then the visit, and
  1.  ; then the prescription based on the visit
  1.  ;
  1.  N PATNAME,SEL,VISITIEN,TTYPE
  1.  N DDS ; they have ScreenMan hooks in ^DIR - they are poison to this
  1.  ;       ABSPOSIF program!  NEW safely disables them for now.
  1.  ; all NEWs above this line ^^^   because there are GOTOs below
  1. RXFINDA I $D(VISITIN) S VISITIEN=VISITIN,PAT=$P(^AUPNVSIT(VISITIEN,0),U,5)
  1.  E  S VISITIEN=0
  1.  I '$G(PAT) S PAT=$$PATFIND I 'PAT G RXFINDX
  1.  I '$D(TYPE) S TYPE=3
  1.  S PATNAME=$P(^DPT(PAT,0),U)
  1.  ;
  1.  I 'VISITIEN D
  1.  . W !,"...Searching for visits and prescriptions for "_PATNAME_" ...",!
  1. RXFINDC S SEL=$$VISIFIND(PAT,TYPE,VISITIEN) I 'SEL K PAT G RXFINDA
  1.  ; Side effect - we still have ^TMP($J,"LIST",SEL,"X")=count of prescs
  1.  S VISITIEN=^TMP($J,"LIST",SEL,"I")
  1.  ;
  1.  ; Are you looking for a visit or for a prescription?
  1.  I TYPE=1 G RXFINDK
  1.  I TYPE=2 Q VISITIEN ; looking for a visit - you've got it - done
  1.  ; But if there are no prescriptions with this visit, and they saw
  1.  ; the list, then just take the visit and don't ask.
  1.  I '$G(VISITIN),'^TMP($J,"LIST",SEL,"X") Q VISITIEN
  1.  S TTYPE=$$TTYPE
  1.  I 'TTYPE K PAT G RXFINDA
  1.  I TTYPE=1 G RXFINDK
  1.  I TTYPE=2 Q VISITIEN
  1.  D IMPOSS^ABSPOSUE("P","TI","Bad TTYPE="_TTYPE,,"RXFINDC",$T(+0))
  1.  ;
  1. RXFINDK ; If there was only one prescription with the visit, that's the one
  1.  ; we take - the drug name and date was shown, we know that's the one
  1.  ;
  1.  I ^TMP($J,"LIST",SEL,"X")=1 D  Q X
  1.  . N RXI S RXI=$O(^TMP($J,"LIST",SEL,"X",""))
  1.  . N RXR S RXR=$O(^TMP($J,"LIST",SEL,"X",RXI,""))
  1.  . S X=RXI_U_RXR
  1.  ;
  1.  I ^TMP($J,"LIST",SEL,"X")=0 D  G RXFINDC
  1.  . W !,"This visit has no prescriptions!   Try again..." H 2 W !
  1.  ;
  1.  S SEL=$$WHICHRX(SEL) I 'SEL G RXFINDC
  1.  Q ^TMP($J,"LIST",SEL,"I") ; RXI^RXR
  1. RXFINDX ; removed call ; ABSP*1.0T7*8 ; D REFRESH^DDSUTL
  1.  Q -1
  1. TTYPE() ; so what are you looking for?
  1.  N PROMPT,DEFAULT,OPT,DISPLAY,CHOICES,TIMEOUT,ANS
  1.  S PROMPT="What kind of charge is this for? "
  1.  S DEFAULT="P",OPT=1,DISPLAY="V"
  1.  S CHOICES="P:Prescription;N:Non-prescription item"
  1.  S TIMEOUT=$S($G(DTOUT):DTOUT,1:300)
  1.  S ANS=$$SET^ABSPOSU3(PROMPT,DEFAULT,OPT,DISPLAY,CHOICES,TIMEOUT)
  1.  Q $S(ANS="P":1,ANS="N":2,1:"")
  1. WHICHRX(SEL)          ; given ^TMP($J,"LIST" and  SEL from visit selection,
  1.  ; present another list to select which prescription
  1.  N TMP M TMP=^TMP($J,"LIST",SEL,"X") ; TMP=count, TMP(RXI,RXR)=""
  1.  N VISIDESC S VISIDESC=^TMP($J,"LIST",SEL,"E")
  1.  K ^TMP($J,"LIST") S ^TMP($J,"LIST",0)=0
  1.  N TYPE S TYPE="S"
  1.  N LISTROOT S LISTROOT="^TMP("_$J_",""LIST"","
  1.  N X S X="1|Prescrip.:10,Drug:30,Fill Date:11,Quantity:10"
  1.  S ^TMP($J,"LIST","Column Headers")=X
  1.  N TITLE S TITLE="Select a prescription for "_PATNAME_" from this visit"
  1.  N PROMPT S PROMPT(1)=VISIDESC
  1.  N OPT S OPT=1
  1.  N ANSROOT S ANSROOT="^TMP($J,""ANS""," K ^TMP($J,"ANS")
  1.  N RXI,RXR S RXI=0 F  S RXI=$O(TMP(RXI)) Q:'RXI  D
  1.  . S RXR="" F  S RXR=$O(TMP(RXI,RXR)) Q:RXR=""  D
  1.  . . N N S (N,^TMP($J,"LIST",0))=^TMP($J,"LIST",0)+1
  1.  . . N Z S Z=$G(^PSRX(RXI,0))
  1.  . . N DRUGIEN S DRUGIEN=$P(Z,U,6)
  1.  . . N DRUGNAME I DRUGIEN S DRUGNAME=$P($G(^PSDRUG(DRUGIEN,0)),U)
  1.  . . E  S DRUGIEN="?"
  1.  . . N DATE,QTY
  1.  . . I RXR D
  1.  . . . N Z S Z=$G(^PSRX(RXI,1,RXR,0))
  1.  . . . S DATE=$P(Z,U)
  1.  . . . S QTY=$P(Z,U,4)
  1.  . . E  D
  1.  . . . S DATE=$P($G(^PSRX(RXI,2)),U,2)
  1.  . . . S QTY=$P(Z,U,7)
  1.  . . N Y S Y=DATE X ^DD("DD") S DATE=Y
  1.  . . S QTY=$$FMTQTY(QTY)
  1.  . . N X S X=$$LJBF("`"_RXI,10)_" "_$$LJBF(DRUGNAME,30)
  1.  . . S X=X_" "_$$LJBF(DATE,11)_" "_$$LJBF($$FMTQTY(QTY),10)
  1.  . . S ^TMP($J,"LIST",N,"E")=X
  1.  . . S ^TMP($J,"LIST",N,"I")=RXI_U_RXR
  1.  S X=$$LIST^ABSPOSU4(TYPE,LISTROOT,ANSROOT,TITLE,.PROMPT,OPT)
  1.  I "^^"[X Q ""
  1.  I X<0 Q ""
  1.  ;IHS/OIT/RCS 7/8/2013 Patch 46 - Only allow one number from list to be selected
  1.  I X'?1N.N Q ""
  1.  Q X
  1. FMTQTY(QTY)        ; decimal, 3 places, but no excess trailing zeroes
  1.  I QTY#1=0 Q QTY_"    "
  1.  S QTY=$J(QTY,0,3)
  1.  I QTY?.E1"."1N1"00" S $E(QTY,$L(QTY)-1,$L(QTY))="  "
  1.  E  I QTY?.E1"."2N1"0" S $E(QTY,$L(QTY))=" "
  1.  Q QTY
  1. VISIFIND(PAT,RXTYPE,VISITIEN)      ; given patient IEN, present a list of visits
  1.  ; if RXTYPE=1, then pick only visits which have prescriptions
  1.  ; returns index of one selected, and ^TMP($J,"LIST",***) left over
  1.  ; returns false if none selected
  1.  ; VISITIEN'=0 means "this is the visit I want, fake it out as if it
  1.  ;   had been selected from the list."
  1.  ;W "In VISIFIND with " ZW PAT,RXTYPE H 1
  1.  I $G(PAT) S PATNAME=$P(^DPT(PAT,0),U)
  1.  N TYPE S TYPE="S" ; single item selection
  1.  N LISTROOT S LISTROOT="^TMP("_$J_",""LIST""," K ^TMP($J,"LIST")
  1.  N X S X="1|Visit:12,Date:14,Clinic:15,Prescriptions:25"
  1.  S ^TMP($J,"LIST","Column Headers")=X
  1.  N ANSROOT S ANSROOT="^TMP("_$J_",""ANS""," K ^TMP($J,"ANS")
  1.  D VISLIST(VISITIEN)
  1.  N TITLE S TITLE="Select a visit"
  1.  I $G(PAT) S TITLE=TITLE_" for "_PATNAME
  1.  N PROMPT S PROMPT="Item number (^ to exit)"
  1.  N OPT S OPT=1
  1.  N X
  1.  I VISITIEN S X=1 ; we specified it, we pretend we selected it
  1.  E  I '^TMP($J,"LIST",0) D  S X=""
  1.  . W PATNAME," has no visits on file.",!
  1.  E  S X=$$LIST^ABSPOSU4(TYPE,LISTROOT,ANSROOT,TITLE,PROMPT,OPT)
  1.  I "^^"[X Q ""
  1.  I X<0 Q ""
  1.  ;IHS/OIT/RCS 7/8/2013 Patch 46 - Only allow one number from list to be selected
  1.  I X'?1N.N Q ""
  1.  Q X
  1. VISLIST(VISITIEN) ; set up LISTROOT ; given PAT ; if $$, it returns the count
  1.  ; variations?  haven't thought it through - for now, must have PAT
  1.  N ROOT S ROOT=$E(LISTROOT,1,$L(LISTROOT)-1)_")"
  1.  S @ROOT@(0)=0
  1.  N TIME9 S TIME9=""
  1.  F  S TIME9=$O(^AUPNVSIT("AA",PAT,TIME9)) Q:'TIME9  D  ; in reverse
  1.  . N VSTIEN S VSTIEN=0
  1.  . F  S VSTIEN=$O(^AUPNVSIT("AA",PAT,TIME9,VSTIEN)) Q:VSTIEN=""  D
  1.  . . I $G(VISITIEN) Q:VISITIEN'=VSTIEN  ; when we want only this one
  1.  . . N VCN,DATE,CLINIC,DELETED,PRESC,RXI,RXR,Z,Y,X,N,RXINFO
  1.  . . S VCN=$P($G(^AUPNVSIT(VSTIEN,"VCN")),U)
  1.  . . I VCN="" S VCN="`"_VSTIEN
  1.  . . S Z=^AUPNVSIT(VSTIEN,0)
  1.  . . I $P(Z,U,11) S VCN="D!"_VCN ; deleted visit!
  1.  . . S Y=$P(Z,U) X ^DD("DD") S DATE=$P(Y,"@")_"@"_$P($P(Y,"@",2),":")
  1.  . . S CLINIC=$P(Z,U,8) I CLINIC S CLINIC=$P($G(^DIC(40.7,CLINIC,0)),U)
  1.  . . ;
  1.  . . S N=@ROOT@(0)+1 ; don't store in @ROOT@(0) until you keep it
  1.  . . ;
  1.  . . D VISRX(VSTIEN,$E(ROOT,1,$L(ROOT)-1)_","_N_",""X"")")
  1.  . . ;
  1.  . . I @ROOT@(N,"X")=1 D  ; exactly one prescription - print drug name
  1.  . . . S RXI=$O(@ROOT@(N,"X",""))
  1.  . . . S RXINFO=$P($G(^PSRX(RXI,0)),U,6)
  1.  . . . I RXINFO S RXINFO=$P($G(^PSDRUG(RXINFO,0)),U)
  1.  . . . I RXINFO="" S RXINFO="missing data"
  1.  . . E  I @ROOT@(N,"X") D  ; more than 1 prescriptions
  1.  . . . S RXINFO=@ROOT@(N,"X")_" prescriptions"
  1.  . . E  D  ; 0 prescriptions
  1.  . . . S RXINFO="none"
  1.  . . I RXINFO="none",RXTYPE=1 Q  ; stop, we only want prescriptions
  1.  . . S X=$$LJBF(VCN,12)
  1.  . . S X=X_" "_$$LJBF(DATE,15)
  1.  . . S X=X_" "_$$LJBF(CLINIC,15)
  1.  . . S X=X_" "_$$LJBF(RXINFO,25)
  1.  . . S @ROOT@(N,"E")=X
  1.  . . S @ROOT@(N,"I")=VSTIEN
  1.  . . S @ROOT@(0)=N
  1.  Q:$Q @ROOT@(0) Q
  1. VISRX(VISIT,ROOT)  ; build @ROOT=count of prescriptions for this visit
  1.  ; @ROOT@(RXI,RXR)="" for each prescription
  1.  ; Jump there via V MEDICATION
  1.  I '$D(@ROOT) S @ROOT=0
  1.  N VMED S VMED=0
  1.  F  S VMED=$O(^AUPNVMED("AD",VISIT,VMED)) Q:VMED=""  D VMEDRX(VMED,ROOT)
  1.  Q
  1. VMEDRX(VMEDIEN,ROOT)         ; called from VISRX
  1.  N RXI,RXR
  1.  S RXI=0 F  S RXI=$O(^PSRX("APCC",VMEDIEN,RXI)) Q:'RXI  D
  1.  . I $D(^(RXI))=1 S @ROOT@(RXI,0)="",@ROOT=@ROOT+1
  1.  . E  S RXR=0 F  S RXR=$O(^PSRX("APCC",VMEDIEN,RXI,RXR)) Q:'RXR  D
  1.  . . S @ROOT@(RXI,RXR)=""
  1.  . . S @ROOT=@ROOT+1
  1.  Q
  1. PATFIND()          ; return patient IEN, or false if none selected
  1.  N DIC,Y,DUOUT,DTOUT,X,DLAYGO,DINUM,RETVAL
  1.  S DIC=2,DIC(0)="AEMNQZ"
  1.  ;
  1.  ; Removed this screen.  If memory serves, this "C" index is not
  1.  ; reliable.  Besides, we need flexibility to find patients and visits
  1.  ; which don't have prescription file entries, since we'll be entering
  1.  ; non-prescription items, too.
  1.  ; ,DIC("S")="I $D(^PSRX(""C"",Y))"
  1.  ;
  1.  D ^DIC ; lookup patient
  1.  Q $S(Y<0:"",1:+Y)
  1. LJBF(X,N)          Q $E(X_$J("",N-$L(X)),1,N)