ABSPOS6E ; IHS/FCS/DRS - more overflow from ^ABSPOS1 ;
;;1.0;PHARMACY POINT OF SALE;**11**;JUN 21, 2001;Build 38
;-------------------------------------------------
;IHS/SD/lwj 06/10/04 patch 11 terminal emulation problems
; OnNetHost interrupts "#" to mean for the cursor to advance
; to the top of the next page. "Other" emulations (including
; CRT and Tera Term) interrupt "#" to mean go to the top of
; the current screen and clear everything on this screen off.
; This was keeping the users at GIMC from being able to see
; the entire receipt. Logic adjusted to work at GIMC.
;-------------------------------------------------
Q
NAME(X) ;EP - from ABSPOS6D
N % S %="DUR info" ; ="receipt"
I '$G(X) Q %
I X=3 ; S %=%_"s" ; plural
I X=1 ; capitalize first letter
I X=2 ; capitalize all
Q %
RECEIPTS(RXIIEN,IO) ;EP - from ABSPOS6D
; Given RXIIEN(*) array of RXIs for which to print receipts
; and IO = IO device, caller does open & close
; $P is current device when this finishes, but IO still open
N PAT
U $P W "Printing ",$$NAME(3),"...",!
; Group by patient ; RXI(pat,rxi)=""
N RXI S RXI="" F S RXI=$O(RXIIEN(RXI)) Q:RXI="" D
. S PAT=$P(^ABSPT(RXI,0),U,6)
. S RXI(PAT,RXI)=""
; Now print them
S PAT="" F S PAT=$O(RXI(PAT)) Q:PAT="" D
. U $P W "... for ",$P(^DPT(PAT,0),U),"...",!
. S RXI="" F S RXI=$O(RXI(PAT,RXI)) Q:RXI="" D
. . N REVERSAL S REVERSAL=$$REVERSAL(RXI)
. . I REVERSAL U IO D RECEIPT(REVERSAL,1) U $P
. . N CLAIM S CLAIM=$$CLAIM(RXI)
. . I 'CLAIM W ?5,"Nothing to print for prescription `",RXI,! H 1 Q
. . N POSITION S POSITION=$P(^ABSPT(RXI,0),"^",9)
. . I 'POSITION W ?5,"This might not be the right ",$$NAME,".",! H 1
. . U IO D RECEIPT(CLAIM,POSITION) U $P
;
;IHS/SD/lwj 6/10/04 patch 11 - nxt line rmkd out, following added
;U IO I $Y'=0 W #
I IO'=$P U IO I $Y'=0 W # ;IHS/SD/lwj 6/10/04 patch 11
;
U $P W "Done",! H 1
Q
CLAIM(RXI) ; $$ return claim #
N CLAIM
;S CLAIM=$G(^ABSPT(RXI,4))
I 0 ;I CLAIM S CLAIM=$P(CLAIM,U) ; do the reversal if applicable
E S CLAIM=$P(^ABSPT(RXI,0),U,4) ; else plain old claim
Q CLAIM
REVERSAL(RXI) Q $P($G(^ABSPT(RXI,4)),U)
RECEIPT(CLAIM,POSITION) ; print a receipt for the given claim packet & pos
N TMP D FILEMAN^ABSPECP1("TMP",CLAIM,,POSITION) ; sets TMP(*)
N TAG S TAG=$P($G(^ABSP(9002313.99,1,"RECEIPT")),U) ; "ANMC" at ANMC
I TAG="" S TAG="RECEIPT"
D @(TAG_U_"ABSPECP3")
Q
ABSPOS6E ; IHS/FCS/DRS - more overflow from ^ABSPOS1 ;
+1 ;;1.0;PHARMACY POINT OF SALE;**11**;JUN 21, 2001;Build 38
+2 ;-------------------------------------------------
+3 ;IHS/SD/lwj 06/10/04 patch 11 terminal emulation problems
+4 ; OnNetHost interrupts "#" to mean for the cursor to advance
+5 ; to the top of the next page. "Other" emulations (including
+6 ; CRT and Tera Term) interrupt "#" to mean go to the top of
+7 ; the current screen and clear everything on this screen off.
+8 ; This was keeping the users at GIMC from being able to see
+9 ; the entire receipt. Logic adjusted to work at GIMC.
+10 ;-------------------------------------------------
+11 QUIT
NAME(X) ;EP - from ABSPOS6D
+1 ; ="receipt"
NEW %
SET %="DUR info"
+2 IF '$GET(X)
QUIT %
+3 ; S %=%_"s" ; plural
IF X=3
+4 ; capitalize first letter
IF X=1
+5 ; capitalize all
IF X=2
+6 QUIT %
RECEIPTS(RXIIEN,IO) ;EP - from ABSPOS6D
+1 ; Given RXIIEN(*) array of RXIs for which to print receipts
+2 ; and IO = IO device, caller does open & close
+3 ; $P is current device when this finishes, but IO still open
+4 NEW PAT
+5 USE $PRINCIPAL
WRITE "Printing ",$$NAME(3),"...",!
+6 ; Group by patient ; RXI(pat,rxi)=""
+7 NEW RXI
SET RXI=""
FOR
SET RXI=$ORDER(RXIIEN(RXI))
IF RXI=""
QUIT
Begin DoDot:1
+8 SET PAT=$PIECE(^ABSPT(RXI,0),U,6)
+9 SET RXI(PAT,RXI)=""
End DoDot:1
+10 ; Now print them
+11 SET PAT=""
FOR
SET PAT=$ORDER(RXI(PAT))
IF PAT=""
QUIT
Begin DoDot:1
+12 USE $PRINCIPAL
WRITE "... for ",$PIECE(^DPT(PAT,0),U),"...",!
+13 SET RXI=""
FOR
SET RXI=$ORDER(RXI(PAT,RXI))
IF RXI=""
QUIT
Begin DoDot:2
+14 NEW REVERSAL
SET REVERSAL=$$REVERSAL(RXI)
+15 IF REVERSAL
USE IO
DO RECEIPT(REVERSAL,1)
USE $PRINCIPAL
+16 NEW CLAIM
SET CLAIM=$$CLAIM(RXI)
+17 IF 'CLAIM
WRITE ?5,"Nothing to print for prescription `",RXI,!
HANG 1
QUIT
+18 NEW POSITION
SET POSITION=$PIECE(^ABSPT(RXI,0),"^",9)
+19 IF 'POSITION
WRITE ?5,"This might not be the right ",$$NAME,".",!
HANG 1
+20 USE IO
DO RECEIPT(CLAIM,POSITION)
USE $PRINCIPAL
End DoDot:2
End DoDot:1
+21 ;
+22 ;IHS/SD/lwj 6/10/04 patch 11 - nxt line rmkd out, following added
+23 ;U IO I $Y'=0 W #
+24 ;IHS/SD/lwj 6/10/04 patch 11
IF IO'=$PRINCIPAL
USE IO
IF $Y'=0
WRITE #
+25 ;
+26 USE $PRINCIPAL
WRITE "Done",!
HANG 1
+27 QUIT
CLAIM(RXI) ; $$ return claim #
+1 NEW CLAIM
+2 ;S CLAIM=$G(^ABSPT(RXI,4))
+3 ;I CLAIM S CLAIM=$P(CLAIM,U) ; do the reversal if applicable
IF 0
+4 ; else plain old claim
IF '$TEST
SET CLAIM=$PIECE(^ABSPT(RXI,0),U,4)
+5 QUIT CLAIM
REVERSAL(RXI) QUIT $PIECE($GET(^ABSPT(RXI,4)),U)
RECEIPT(CLAIM,POSITION) ; print a receipt for the given claim packet & pos
+1 ; sets TMP(*)
NEW TMP
DO FILEMAN^ABSPECP1("TMP",CLAIM,,POSITION)
+2 ; "ANMC" at ANMC
NEW TAG
SET TAG=$PIECE($GET(^ABSP(9002313.99,1,"RECEIPT")),U)
+3 IF TAG=""
SET TAG="RECEIPT"
+4 DO @(TAG_U_"ABSPECP3")
+5 QUIT
