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

ABSPOSMC.m

Go to the documentation of this file. 
  1. ABSPOSMC ; IHS/FCS/DRS - General Inquiry/Report .57; [ 09/12/2002  10:14 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
  1.  Q
  1.  ; Local array ABSPOSMA() contains the parameters:
  1.  ; ABSPOSMA("BY WHICH DATE")="TRANSACTION" or "RELEASED"
  1.  ; ABSPOSMA("MODE")="INQUIRY" or "REPORT"
  1.  ; ABSPOSMA("SORT",7,"FR")=transaction date/time, start value
  1.  ; ABSPOSMA("SORT",7,"TO")=transaction date/time, to value
  1.  ; ABSPOSMA("SORT",9999.95,"FR")=released date/time, start value
  1.  ; ABSPOSMA("SORT",9999.95,"TO")=released date/time, to value
  1.  ; ABSPOSMA("SORT",field #,"FR")=other field sort, start value
  1.  ; ABSPOSMA("SORT",field #,"TO")=other field sort, to value
  1.  ; ABSPOSMA("OUTPUT TYPE")=one of the codes (see ABSPOSMZ for list)
  1. CONTINUE ;EP - continued (via GOTO) from ABSPOSMB
  1.  N L,DIC,FLDS,BY,FR,TO,DHD,DIASKHD,DIPCRIT,PG,DHIT,DIOEND,DIOBEG
  1.  N DCOPIES,IOP,DQTIME,DIS,DISUPNO,DISTOP,DISPAR
  1.  N SELECT,ANSCOUNT,X,ACTION
  1. A ;
  1.  D DIPSETUP
  1.  I ABSPOSMA("MODE")="INQUIRY" D INILIST,INIANS
  1.  ; - - - - - - - - - - sort and print - - - - - - - - - - - -
  1.  I ABSPOSMA("MODE")="INQUIRY" W "Searching...",!
  1.  D EN1^DIP
  1.  I ABSPOSMA("MODE")="REPORT" Q  ; If in Report mode, we're finished
  1.  ; - - - - -  Inquiry mode  - - - - - display list and select - - - - -
  1.  I '@$$LIST@(0) D  Q  ; If empty list, quit.
  1.  . W "No transactions found with these criteria."
  1.  W "Found ",@$$LIST@(0)," transactions.",! H 2
  1. SELECT S SELECT=$$SELECT1 ; we expect to get back "^"
  1.  Q:(SELECT="^^")!(SELECT=-1)
  1.  S X=0 F ANSCOUNT=0:1 S X=$O(@$$ANSLIST@(X)) Q:X=""
  1.  W !,"Selected ",ANSCOUNT," item",$S(ANSCOUNT=1:"",1:"s"),! H 2
  1.  D IEN57
  1.  I 'ANSCOUNT H 2 Q
  1. ACTION S ACTION=$$OUTPUT^ABSPOSMZ
  1.  I ACTION="" H 2 G SELECT ;Q
  1.  D ACTION^ABSPOSMD
  1.  G ACTION ; otherwise, branch back for more inquiry
  1. SELECT1() ;
  1.  N TYPE,LROOT,AROOT,STITLE,PROMPT,OPT,PGLEN,TIMEOUT
  1.  S TYPE="M" ; multiple selection
  1.  S LROOT=$$OPEN($$LIST)
  1.  S AROOT=$$OPEN($$ANSLIST)
  1.  S STITLE="Pharmacy Point of Sale - Inquiry Screen"
  1.  ;S PROMPT(1)="Select line number(s)"
  1.  S OPT=1 ; optional response
  1.  S PGLEN=12 ; 
  1.  S TIMEOUT=600
  1.  D INIANS ; erase any previous answers
  1.  N X
  1.  S X=$$LIST^ABSPOSU4(TYPE,LROOT,AROOT,STITLE,,OPT,PGLEN,TIMEOUT)
  1.  Q X
  1. OPEN(X) ;EP -
  1.  Q $E(X,1,$L(X)-1)_"," ; convert to open root
  1. LIST() ;EP
  1.  Q "^TMP("""_$T(+0)_""","_$J_",""LIST"")"
  1. ANSLIST() ; EP
  1.  Q "^TMP("""_$T(+0)_""","_$J_",""ANS"")"
  1. ANSCOUNT() Q @$$ANSLIST@(0)
  1. IENLIST() ; EP
  1.  Q "^TMP("""_$T(+0)_""","_$J_",""IEN57"")"
  1. IEN57 ; build IEN57 list based on ANSLIST
  1.  N A,B,C S A=$$ANSLIST,B=$$IENLIST,C=$$LIST K @B
  1.  N X,IEN57 S X=0
  1.  F  S X=$O(@A@(X)) Q:'X  D
  1.  . S IEN57=@C@(X,"I")
  1.  . S @B@(IEN57)=""
  1.  Q
  1. INILIST K @$$LIST
  1.  S @$$LIST@(0)=0
  1.  S @$$LIST@("Column HEADERs")="2|Presc/Fill:12,Trans. Date:11,Stat:5,Patient and Drug:35"
  1.  Q
  1. INIANS K @$$ANSLIST Q
  1.  ;
  1. DIPSETUP ; This routine sets up the call to EN1^DIP
  1.  S L=0
  1.  S DIC=9002313.57
  1.  D FLDS
  1.  D BY
  1.  D FR ; FR and TO
  1.  D DHD ; header
  1.  K DIASKHD ; do not prompt user for a header
  1.  S DIPCRIT=1 ; SORT criteria will print in the header of first page
  1.  K PG ; start at page 1
  1.  I ABSPOSMA("MODE")="INQUIRY" D  ; build the list
  1.  . S DHIT="D DHIT^"_$T(+0)
  1.  E  K DHIT
  1.  ; DIOEND ; executed at end of printout
  1.  ; DIOBEG ; executed before printing begins
  1.  ; DCOPIES
  1.  ; IOP
  1.  I ABSPOSMA("MODE")="INQUIRY" S IOP="HOME;80"
  1.  ; DQTIME
  1.  D DIS ; screens
  1.  ; S DISUPNO=1
  1.  S DISTOP="I 1" ; allow user to stop queued print
  1.  ; DISTOP("C")
  1.  Q
  1. FLDS ; Which fields to print?  If inquiry mode:  print no fields
  1.  I ABSPOSMA("MODE")="INQUIRY" S FLDS="""""" Q
  1.  ; Report mode:  set to the appropriate template.
  1.  ; Temporary - just to put something in there.
  1.  S FLDS="[CAPTIONED]"
  1.  Q
  1. BY ; Which fields to sort on?
  1.  I '$D(ABSPOSMA("SORT")) K BY Q  ; doing Fileman sort; leave BY undef
  1.  ; Always primary sort is on transaction date.
  1.  S BY="@-LAST UPDATE"
  1.  I ABSPOSMA("BY WHICH DATE")="RELEASED" S BY=BY_",@9999.95"
  1.  N F S F=""
  1.  F  S F=$O(ABSPOSMA("SORT",F)) Q:F=""  D
  1.  . Q:F=7  Q:F=9999.95  ; one of the date fields we already have
  1.  . S BY=BY_",@"_F ; append
  1.  S BY=BY_",@NUMBER" ; tie breaker
  1.  Q
  1. FR ; FR and TO range of sort
  1.  ; order must correspond with order of BY fields
  1.  S (FR,TO)=""
  1.  N F F F=7,9999.95 D FR1
  1.  S F=""
  1.  F  S F=$O(ABSPOSMA("SORT",F)) Q:F=""  I F'=7,F'=9999.95 D FR1
  1.  S FR=FR_",",TO=TO_"," ; NUMBER sort
  1.  Q
  1. FR1 ;
  1.  Q:'$D(ABSPOSMA("SORT",F))
  1.  S:FR]"" FR=FR_"," S FR=FR_ABSPOSMA("SORT",F,"FR")
  1.  S:TO]"" TO=TO_"," S TO=TO_ABSPOSMA("SORT",F,"TO")
  1.  Q
  1. DHD ; Header
  1.  I ABSPOSMA("MODE")="INQUIRY" S DHD="W !,""Searching..."""
  1.  Q
  1. DIS ; screens
  1.  K DIS
  1.  N I F I=0:1 Q:'$D(ABSPOSMA("SCREEN",I))  S DIS(I)=ABSPOSMA("SCREEN",I)
  1.  Q
  1. DHIT ;EP - called here indirectly when in Inquiry mode and a hit is found
  1.  ;W "." W:$X>70 !
  1.  N IEN57,NLINE,DATA,X S IEN57=D0 ; D0 points to the entry
  1.  S (NLINE,@$$LIST@(0))=@$$LIST@(0)+1
  1.  ; Line number - comes automatically, we don't need to put it in.
  1.  S DATA="" ;$J(NLINE,4)_" "
  1.  ; Prescription and fill number
  1.  S DATA=DATA_$J("`"_$$RXI^ABSPOS57,9)
  1.  S X=$$RXR^ABSPOS57
  1.  I X D
  1.  . S DATA=DATA_"/"_X
  1.  . I X<10 S DATA=DATA_" "
  1.  E  S DATA=DATA_"   "
  1.  S DATA=DATA_"  "
  1.  ; Transaction date
  1.  S X=$P(^ABSPTL(IEN57,0),U,8)
  1.  N XD,XT S XD=$P(X,"."),XT=$P(X,".",2)
  1.  N SY S SY=$E(X,2,3)=$E(DT,2,3) ; SY = same year?
  1.  I DT=XD S XD="T"
  1.  E  I DT-1=XD S XD="T-1"
  1.  E  I DT-2=XD S XD="T-2"
  1.  E  S XD=+$E(XD,4,5)_"/"_+$E(XD,6,7)_$S(SY:"",1:"/"_$E(XD,2,3))
  1.  S XD=XD_"@"_+$E(XT,1,2)
  1.  I $L(XD)<9 S XD=XD_":"_$E(XT,3,4)
  1.  S DATA=DATA_$E(XD_"       ",1,11)_"  "
  1.  ; Result
  1.  S X=$$GET1^DIQ(9002313.57,IEN57_",","RESULT WITH REVERSAL")
  1.  I X]"" D
  1.  . N Y S Y=$O(^ABSPF(9002313.83,"B",X,0))
  1.  . I Y S Y=$P(^ABSPF(9002313.83,Y,0),U,2)
  1.  . I Y]"" S X=Y
  1.  S X=$E(X_"     ",1,5)
  1.  S DATA=DATA_X_"  "
  1.  ; Patient and drug
  1.  S X=$$PATIENT^ABSPOS57
  1.  I X S X=$P($G(^DPT(X,0)),U) ; just last,first
  1.  I X[" " S X=$P(X," ")_" "_$E($P(X," ",2)) ; and middle initial
  1.  S X=X_" / "_$$DRGNAME^ABSPOS57
  1.  S DATA=DATA_$E(X_$J("",35),1,35)
  1.  S @$$LIST@(NLINE,"E")=DATA
  1.  S @$$LIST@(NLINE,"I")=IEN57
  1.  Q