ABSPOSMA ; IHS/FCS/DRS - General Inquiry/Report .57; [ 08/28/2002 3:01 PM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
Q
; General inquiry and reporting on the Transaction File, 9002313.57.
; First menu selection determines whether you're doing an inquiry
; or a report.
; Second menu selection determines how to select transactions.
; If you're doing an inquiry, do the search only. Then display
; a list of the claims. Select one or more and then you get the
; prompt for what kind of output to generate.
; Third menu selection determines what kind of output to generate.
; You get this right away if you're operating in report mode.
;
; Primary sort is always by date/time, usually transaction date/time.
; If sorting by released date (date only, can't do it by time),
; for efficiency, pre-scan 9002313.61 Report Master file and
; determine a range of transaction date/time to search by.
;
; Transaction date/time means the LAST UPDATE field.
;
; Local array ABSPOSMA() contains the parameters:
; ABSPOSMA("BY WHICH DATE")="TRANSACTION" or "RELEASED"
; ABSPOSMA("MODE")="INQUIRY" or "REPORT"
; ABSPOSMA("SORT",7,"FR")=transaction date/time, start value
; ABSPOSMA("SORT",7,"TO")=transaction date/time, to value
; Released date/time - 9999.95 - is applicable
; only if ABSPOSMA("BY WHICH DATE")="RELEASED"
; ABSPOSMA("SORT",9999.95,"FR")=released date/time, start value
; ABSPOSMA("SORT",9999.95,"TO")=released date/time, to value
; Other sort fields are always field name, not field number.
; This way, you can $O(ABSPOSMA("SORT"," ")) to find out
; what kind of a sort is being done.
; ABSPOSMA("SORT",field name,"FR")=other field sort, start value
; ABSPOSMA("SORT",field name,"TO")=other field sort, to value
;
; ABSPOSMA("SCREEN",n)=screens, to be copied to DIS(n)
; ABSPOSMA("OUTPUT TYPE")=see list of codes in ABSPOSMZ
;
;-----------------------------------------------------------
;IHS/SD/lwj 8/28/02 Cache cannot handle a reverse $O of an
; array, so the logic used to retrieve the last entry in
; ABSPOSMA("SCREEN") had to be altered somewhat. (subroutine
; ADDSCREE
;-----------------------------------------------------------
;
INIT ; EP - init ABSPOSMA
; Nice idea for future - retain settings on user-by-user basis
K ABSPOSMA
S ABSPOSMA("BY WHICH DATE")="TRANSACTION"
S (ABSPOSMA("SORT",7,"FR"),ABSPOSMA("SORT",7,"TO"))="?"
S ABSPOSMA("MODE")="INQUIRY"
S ABSPOSMA("OUTPUT TYPE")=$$DEFOUT^ABSPOSMZ
S ABSPOSMA("SCREEN",0)="I $D(^ABSPECX(""RPT"",""AE"",D0))" ; only the most recent transaction for any one given presc. ; 1" ; easier to fill in a dummy here
Q
KILLSORT ; EP - kill all sort fields except the date/time ones
N A S A=0 F S A=$O(ABSPOSMA("SORT",A)) Q:A="" D
. Q:A=7 Q:A=9999.95&(ABSPOSMA("BY WHICH DATE"))="RELEASED"
. K ABSPOSMA("SORT",A)
Q
ADDSCREE(X) ; store the screen, xecutable code stored in X
;IHS/SD/lwj 8/28/02 Cache cannot do a reverse $O on an array
; so we had to change the logic used to retrieve the last
; array entry in ABSPOSMA - nxt line remarked out and
; the two following were added
;S ABSPOSMA("SCREEN",$O(ABSPOSMA("SCREEN",""),-1)+1)=X Q
N ABSPL,ABSPLST
S ABSPL=""
F S ABSPL=$O(ABSPOSMA("SCREEN",ABSPL)) Q:ABSPL="" S ABSPLST=ABSPL
S ABSPOSMA("SCREEN",ABSPLST+1)=X Q
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Handling for each of the ABSP INQUIRY options
; Each of these does the following:
; D INIT ; init ABSPOSMA()
; ; then its own specific setup
; G JOIN
; And at JOIN, then all go to JOIN^ABSPOSMB
; Eventually, EN1^DIP will do all the work for us,
; both sorting and printing.
JOIN G JOIN^ABSPOSMB
;
PHARM ; EP - Option ABSP INQUIRY BY PHARMACY
D INIT
N PHARM S PHARM=$$ASKPHARM^ABSPOSMZ
Q:'PHARM
S ABSPOSMA("SORT","PHARMACY","FR")=$P(^ABSP(9002313.56,PHARM,0),U)
S ABSPOSMA("SORT","PHARMACY","TO")=$P(^ABSP(9002313.56,PHARM,0),U)
Q
PATIENT ; EP - Option ABSP INQUIRY BY PATIENT
; Select a list of patients.
; Build screens corresponding to the list (i.e., it's not a sort item)
; I $P(^ABSPTL(D0,0),U,6)=patient ien
D INIT
N PAT F S PAT=$$ASKPAT^ABSPOSMZ Q:'PAT D
. D ADDSCREE("I $P(^ABSPTL(D0,0),U,6)="_PAT)
G JOIN
RESTYPE ; EP - Option ABSP INQUIRY BY RESULT TYPE
; Select from the entries in file 9002313.83
; Build screens corresponding to the list (i.e., it's not a sort item)
D INIT
N R F S R=$$ASKRTYPE^ABSPOSMZ Q:R="" D
. D ADDSCREE("I $$GET1^DIQ(9002313.57,D0_"","",""RESULT WITH REVERSAL"")="""_R_"""")
G JOIN
CLAIMID ; EP - Option ABSP INQUIRY BY CLAIM ID
; A sort criterion. Prompt for FR and TO.
; Lookup on file 9002313.02 now?
D INIT
D KILLSORT
S ABSPOSMA("SORT","CLAIM:Claim ID","FR")="?"
S ABSPOSMA("SORT","CLAIM:Claim ID","TO")="?"
G JOIN
INSURER ; EP - Option ABSP INQUIRY BY INSURER
D INIT
S ABSPOSMA("SORT","INSURER","FR")="?"
S ABSPOSMA("SORT","INSURER","TO")="?"
G JOIN
NDC ; EP - Option ABSP INQUIRY BY NDC NUMBER
D INIT
W !,"When prompted for NDC number, use the 11-digit form "
W "with no hyphens.",! H 2
S ABSPOSMA("SORT","ABSBNDC","FR")="?"
S ABSPOSMA("SORT","ABSBNDC","TO")="?"
G JOIN
PRICE ; EP - Option ABSP INQUIRY BY PRICE
D INIT
S ABSPOSMA("SORT","TOTAL PRICE","FR")="?"
S ABSPOSMA("SORT","TOTAL PRICE","TO")="?"
G JOIN
FM ; EP - Option ABSP INQUIRY BY FILEMAN
; we will leave the BY undefined
D INIT
K ABSPOSMA("SORT")
G JOIN
ONLY ; EP - Option ABSP INQUIRY BY DATE ONLY
D INIT
D KILLSORT
G JOIN
TEST D ONLY Q
ABSPOSMA ; IHS/FCS/DRS - General Inquiry/Report .57; [ 08/28/2002 3:01 PM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 QUIT
+3 ; General inquiry and reporting on the Transaction File, 9002313.57.
+4 ; First menu selection determines whether you're doing an inquiry
+5 ; or a report.
+6 ; Second menu selection determines how to select transactions.
+7 ; If you're doing an inquiry, do the search only. Then display
+8 ; a list of the claims. Select one or more and then you get the
+9 ; prompt for what kind of output to generate.
+10 ; Third menu selection determines what kind of output to generate.
+11 ; You get this right away if you're operating in report mode.
+12 ;
+13 ; Primary sort is always by date/time, usually transaction date/time.
+14 ; If sorting by released date (date only, can't do it by time),
+15 ; for efficiency, pre-scan 9002313.61 Report Master file and
+16 ; determine a range of transaction date/time to search by.
+17 ;
+18 ; Transaction date/time means the LAST UPDATE field.
+19 ;
+20 ; Local array ABSPOSMA() contains the parameters:
+21 ; ABSPOSMA("BY WHICH DATE")="TRANSACTION" or "RELEASED"
+22 ; ABSPOSMA("MODE")="INQUIRY" or "REPORT"
+23 ; ABSPOSMA("SORT",7,"FR")=transaction date/time, start value
+24 ; ABSPOSMA("SORT",7,"TO")=transaction date/time, to value
+25 ; Released date/time - 9999.95 - is applicable
+26 ; only if ABSPOSMA("BY WHICH DATE")="RELEASED"
+27 ; ABSPOSMA("SORT",9999.95,"FR")=released date/time, start value
+28 ; ABSPOSMA("SORT",9999.95,"TO")=released date/time, to value
+29 ; Other sort fields are always field name, not field number.
+30 ; This way, you can $O(ABSPOSMA("SORT"," ")) to find out
+31 ; what kind of a sort is being done.
+32 ; ABSPOSMA("SORT",field name,"FR")=other field sort, start value
+33 ; ABSPOSMA("SORT",field name,"TO")=other field sort, to value
+34 ;
+35 ; ABSPOSMA("SCREEN",n)=screens, to be copied to DIS(n)
+36 ; ABSPOSMA("OUTPUT TYPE")=see list of codes in ABSPOSMZ
+37 ;
+38 ;-----------------------------------------------------------
+39 ;IHS/SD/lwj 8/28/02 Cache cannot handle a reverse $O of an
+40 ; array, so the logic used to retrieve the last entry in
+41 ; ABSPOSMA("SCREEN") had to be altered somewhat. (subroutine
+42 ; ADDSCREE
+43 ;-----------------------------------------------------------
+44 ;
INIT ; EP - init ABSPOSMA
+1 ; Nice idea for future - retain settings on user-by-user basis
+2 KILL ABSPOSMA
+3 SET ABSPOSMA("BY WHICH DATE")="TRANSACTION"
+4 SET (ABSPOSMA("SORT",7,"FR"),ABSPOSMA("SORT",7,"TO"))="?"
+5 SET ABSPOSMA("MODE")="INQUIRY"
+6 SET ABSPOSMA("OUTPUT TYPE")=$$DEFOUT^ABSPOSMZ
+7 ; only the most recent transaction for any one given presc. ; 1" ; easier to fill in a dummy here
SET ABSPOSMA("SCREEN",0)="I $D(^ABSPECX(""RPT"",""AE"",D0))"
+8 QUIT
KILLSORT ; EP - kill all sort fields except the date/time ones
+1 NEW A
SET A=0
FOR
SET A=$ORDER(ABSPOSMA("SORT",A))
IF A=""
QUIT
Begin DoDot:1
+2 IF A=7
QUIT
IF A=9999.95&(ABSPOSMA("BY WHICH DATE"))="RELEASED"
QUIT
+3 KILL ABSPOSMA("SORT",A)
End DoDot:1
+4 QUIT
ADDSCREE(X) ; store the screen, xecutable code stored in X
+1 ;IHS/SD/lwj 8/28/02 Cache cannot do a reverse $O on an array
+2 ; so we had to change the logic used to retrieve the last
+3 ; array entry in ABSPOSMA - nxt line remarked out and
+4 ; the two following were added
+5 ;S ABSPOSMA("SCREEN",$O(ABSPOSMA("SCREEN",""),-1)+1)=X Q
+6 NEW ABSPL,ABSPLST
+7 SET ABSPL=""
+8 FOR
SET ABSPL=$ORDER(ABSPOSMA("SCREEN",ABSPL))
IF ABSPL=""
QUIT
SET ABSPLST=ABSPL
+9 SET ABSPOSMA("SCREEN",ABSPLST+1)=X
QUIT
+10 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+11 ; Handling for each of the ABSP INQUIRY options
+12 ; Each of these does the following:
+13 ; D INIT ; init ABSPOSMA()
+14 ; ; then its own specific setup
+15 ; G JOIN
+16 ; And at JOIN, then all go to JOIN^ABSPOSMB
+17 ; Eventually, EN1^DIP will do all the work for us,
+18 ; both sorting and printing.
JOIN GOTO JOIN^ABSPOSMB
+1 ;
PHARM ; EP - Option ABSP INQUIRY BY PHARMACY
+1 DO INIT
+2 NEW PHARM
SET PHARM=$$ASKPHARM^ABSPOSMZ
+3 IF 'PHARM
QUIT
+4 SET ABSPOSMA("SORT","PHARMACY","FR")=$PIECE(^ABSP(9002313.56,PHARM,0),U)
+5 SET ABSPOSMA("SORT","PHARMACY","TO")=$PIECE(^ABSP(9002313.56,PHARM,0),U)
+6 QUIT
PATIENT ; EP - Option ABSP INQUIRY BY PATIENT
+1 ; Select a list of patients.
+2 ; Build screens corresponding to the list (i.e., it's not a sort item)
+3 ; I $P(^ABSPTL(D0,0),U,6)=patient ien
+4 DO INIT
+5 NEW PAT
FOR
SET PAT=$$ASKPAT^ABSPOSMZ
IF 'PAT
QUIT
Begin DoDot:1
+6 DO ADDSCREE("I $P(^ABSPTL(D0,0),U,6)="_PAT)
End DoDot:1
+7 GOTO JOIN
RESTYPE ; EP - Option ABSP INQUIRY BY RESULT TYPE
+1 ; Select from the entries in file 9002313.83
+2 ; Build screens corresponding to the list (i.e., it's not a sort item)
+3 DO INIT
+4 NEW R
FOR
SET R=$$ASKRTYPE^ABSPOSMZ
IF R=""
QUIT
Begin DoDot:1
+5 DO ADDSCREE("I $$GET1^DIQ(9002313.57,D0_"","",""RESULT WITH REVERSAL"")="""_R_"""")
End DoDot:1
+6 GOTO JOIN
CLAIMID ; EP - Option ABSP INQUIRY BY CLAIM ID
+1 ; A sort criterion. Prompt for FR and TO.
+2 ; Lookup on file 9002313.02 now?
+3 DO INIT
+4 DO KILLSORT
+5 SET ABSPOSMA("SORT","CLAIM:Claim ID","FR")="?"
+6 SET ABSPOSMA("SORT","CLAIM:Claim ID","TO")="?"
+7 GOTO JOIN
INSURER ; EP - Option ABSP INQUIRY BY INSURER
+1 DO INIT
+2 SET ABSPOSMA("SORT","INSURER","FR")="?"
+3 SET ABSPOSMA("SORT","INSURER","TO")="?"
+4 GOTO JOIN
NDC ; EP - Option ABSP INQUIRY BY NDC NUMBER
+1 DO INIT
+2 WRITE !,"When prompted for NDC number, use the 11-digit form "
+3 WRITE "with no hyphens.",!
HANG 2
+4 SET ABSPOSMA("SORT","ABSBNDC","FR")="?"
+5 SET ABSPOSMA("SORT","ABSBNDC","TO")="?"
+6 GOTO JOIN
PRICE ; EP - Option ABSP INQUIRY BY PRICE
+1 DO INIT
+2 SET ABSPOSMA("SORT","TOTAL PRICE","FR")="?"
+3 SET ABSPOSMA("SORT","TOTAL PRICE","TO")="?"
+4 GOTO JOIN
FM ; EP - Option ABSP INQUIRY BY FILEMAN
+1 ; we will leave the BY undefined
+2 DO INIT
+3 KILL ABSPOSMA("SORT")
+4 GOTO JOIN
ONLY ; EP - Option ABSP INQUIRY BY DATE ONLY
+1 DO INIT
+2 DO KILLSORT
+3 GOTO JOIN
TEST DO ONLY
QUIT
