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