ABSPOSIV ; IHS/FCS/DRS - Old-style input ; [ 09/12/2002 10:11 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,10,48**;JUN 21, 2001;Build 38
; old-style kept for those who want it
;EP - Branched to here from ABSPOSI
;----------------------------------------------------------------------
;IHS/SD/lwj 03/10/04 patch 10
; Routine adjusted to call ABSPFUNC to retrieve
; the Prescription Refill NDC value. At some
; point the call needs to be modified to call APSPFUNC.
; See ABSPFUNC for details on why call was done.
;----------------------------------------------------------------------
;
N ABSBRXI,ABSBRXR,ABSBNDC
N DEFNDCNO D ; true/false, should we default NDC #?
. N X D GET515^ABSPOSI(DUZ,.X) S DEFNDCNO=$P($G(X(100)),U)
N X S X=$$READER(99)
I X<0 W !,"Because of ""^"", no claims are filed.",! H 3 Q ; 03/22/2001
I X="SCREENMAN" G ALL1^ABSPOSI
N ECHO,ORIGIN S ECHO=1,ORIGIN=3 ; 3 = from old style input
I $O(ABSBRXI("")) D FILING(ECHO,ORIGIN)
Q
FILING(ECHO,ORIGIN) ;EP - from ABSPOSRB
; with ABSBRXI(*),ABSBRXR(*) set up
I '$D(ECHO) S ECHO=1
I ECHO W "..."
F5 N IEN51 S IEN51=$$NEWREC^ABSPOSI($O(ABSBRXI(" "),-1),0,ORIGIN)
I ECHO W "..."
I '$$INIT^ABSPOSI(IEN51) G F5:$$IMPOSS^ABSPOSUE("FM,P","TRI","INIT^ABSPOSI failed",,"FILING",$T(+0)) ; it can't fail
I ECHO W "..."
D FILEARAY ; store local arrays into 9002313.51
I ECHO W "..."
D FILE^ABSPOSIZ(IEN51,ECHO) ;same FILE^ABSPOSIZ as what Screenman input uses to do filing
I ECHO W !
Q
TEST ; testing READER
S X=$$READER
W "Returned value from READER was ",X,!
Q
READER(MAXINPUT) ; Get input for Pharmacy POS.
; Returns 0 if all is well, nonzero if there's any problems.
; DEFNDC should only be there from my TESTONE entry point
;
W !!,"Scan the prescription and NDC numbers.",!
W "Press ENTER when done and the claims will be processed.",!
W "Type ^ to stop without sending claims.",!
W !
N INDEX S INDEX=0
N RETVAL
I '$D(MAXINPUT) S MAXINPUT=10
F INDEX=1:1:MAXINPUT S RETVAL=$$READER10 Q:RETVAL<1 I RETVAL>1 D
.S ABSBRXI(INDEX)=ABSBRXI
.S ABSBRXR(INDEX)=ABSBRXR
.S ABSBNDC(INDEX)=ABSBNDC
W ! ; when you pressed ENTER, it didn't echo.
I RETVAL<0 Q RETVAL
I ABSBRXI="SCREENMAN" Q ABSBRXI
READER99 Q 0
;
; FILEARAY is used by $$READER as well as some testing programs
; Moves ABSBRXI(*), ABSBRXR(*), ABSBNDC(*) into the .51 input file,
; just as if it had been entered through Screenman via ^ABSPOSI
; Later, call to ABPOSIZ will carry it into .59
; Needs: IEN51,ABSBRXI(*),ABSBRXR(*),ABSBNDC(*)
FILEARAY ; TO BE MOVED TO ABSPOSIZ: D INCSTAT^ABSPOSUD($T(+0),1)
I 0 W "At FILEARAY with ",! D
. N A S A="" F S A=$O(ABSBRXI(A)) Q:'A D
. . W A,?5,ABSBRXI(A),?20,ABSBRXR(A),?25,ABSBNDC(A),!
N I,FDA,MSG,SUBF,IENS S SUBF=9002313.512
F I=1:1 Q:'$D(ABSBRXI(I)) D
. N PAT S PAT=$P(^PSRX(ABSBRXI(I),0),U,2)
. S IENS=I_","_IEN51_","
. S FDA(SUBF,IENS,.01)=I
. S FDA(SUBF,IENS,.03)=ABSBNDC(I)
. S FDA(SUBF,IENS,1.01)=ABSBRXI(I)
. S FDA(SUBF,IENS,1.02)=ABSBRXR(I)
. S FDA(SUBF,IENS,1.04)=PAT
; next line changed from UPDATE^DIE 09/21/2000
FA5 D FILE^DIE("","FDA","MSG")
I $D(MSG) D LOG^ABSPOSL2("FA5^ABSPOSIV",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
I $D(MSG) D G F5:$$IMPOSS^ABSPOSUE("FM","TRI","FILE^DIE failed",,"FILEARAY",$T(+0))
. W !,"Unexpected error in FILEARAY^"_$T(+0),!
. D ZWRITE^ABSPOS("ABSBRXI","ABSBRXR","ABSBNDC","MSG")
; TO BE MOVED TO ABSPOSIZ: D ADDSTAT^ABSPOSUD($T(+0),2,INDEX-1)
Q
;
; $$SETRXR used by $$READER10 and maybe by others.
; Called from PAT3^ABSPOS15
SETRXR() Q +$O(^PSRX(ABSBRXI,1,"A"),-1) ;most recent refill ^PSRX(ien,
;
; $$DEFNDC used by $$READER10/$$GETNDC and maybe others.
DEFNDC() ;EP - from ABSPOSIW, ABSPOSRB
;IHS/SD/lwj 03/10/04 patch 10 nxt line rmkd out, new line added
;I ABSBRXR Q $P($G(^PSRX(ABSBRXI,1,ABSBRXR,0)),U,13)
I ABSBRXR Q $$NDCVAL^ABSPFUNC(ABSBRXI,ABSBRXR) ;patch 10
E Q $P($G(^PSRX(ABSBRXI,2)),U,7)
;IHS/SD/lwj 03/10/04 patch 10 end change
;
READER10() ; Get the inputs
; INDEX = which one you're on (1 = first, 2 = second, etc.)
; Return -1 if the user wants out
; Return 0 if input is complete ("" response to Prescription #)
; Return >0,<1 if some kind of problem with input (a try-again)
; Return >1 if all is well as good for storage
; Sets ABSBRXI,ABSBRXR,ABSBNDC
;
; Prompt user for "Prescription: "
; Set ABSBRXI=ien for ^PSRX(ien,
;
READER11 ; branch back if "SCREENMAN" entered too late
S ABSBRXI=$$GETRX() ; sets ABSBRXR, too
I ABSBRXI="SCREENMAN" Q:INDEX=1 ABSBRXI D G READER11
. W !,"Typing SCREENMAN has to be done at the very beginning.",!
. W "For now, you're stuck in this old-style input.",!
. W "Answer with ^ to get out without doing anything.",!
;
W !
I ABSBRXI<1 Q $S(ABSBRXI["^":-1,ABSBRXI="":0,1:0.01)
;
S ABSBNDC=$$GETNDC^ABSPOSIW()
W !
;ZW ABSBNDC
I 'ABSBNDC W !,"Try again.",! H 2 G READER11 ; 03/22/2001 ;Q 0.04
;
READER19 Q ABSBRXI ; return big #, since all is well for storage
; with ABSBRXR, ABSBNDC
;
; Compute time difference
TDIF(H0,H1) Q $P(H1,",")-$P(H0,",")*86400+$P(H1,",",2)-$P(H0,",",2)
;
GETRX() ;EP - from ABSPOS6L,ABSPOS6M
;Prompt - get prescription
; Return "" or "^" or "^^" or prescription IEN.
; Return -1 (?) if prescription not found.
; Returns prescription IEN_"R" if you are requesting a reversal.
; ^^^^ that last part isn't implemented yet.
N X,Y,PT,DG,DIC
GETRX1 ;
S X=$$FREETEXT^ABSPOSU2("Prescription: ",,1,1,31,$G(DTIME))
I "^^"[X Q X ;Q:X="^" "^" Q:X="" X
;
S X=$TR(X,"abcdefghijklmnopqrstuvwyxz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
I $E("SCREENMAN",1,$L(X))=X Q "SCREENMAN"
;
; Bar code labels at ANMC have a prefix, "-", and the internal #
I X["-" S X=$P(X,"-",2),X="`"_X
;
; If input was pure numeric, look at parameter to determine whether it
; is an internal or external prescription number. If internal,
; prefix the "`". See too the "+X" to strip leading zeroes. This
; might be the case with a bar code input.
;
I X?1N.N D
. I $P($G(^ABSP(9002313.99,1,"INPUT")),U)=0 S X="`"_+X
. ; else it's an external number; leave it alone
;
; Maybe typed RX followed by an RX external number
;
I $P(X," ")="RX" S X=+$P(X," ",2)
;
S DIC="^PSRX(",DIC(0)="N" D ^DIC
I Y<1 D G GETRX1
.W !,"INPUT - Prescription "_X_" not found.",!
S Y=+Y
S X=$G(^PSRX(Y,0))
S PT=$P(X,U,2),DG=$P(X,U,6)
I PT]"" W " ",$P($G(^DPT(PT,0)),U)
I DG]"" W " ",$P($G(^PSDRUG(DG,0)),U)
S ABSBRXI=Y,ABSBRXR=$$SETRXR
N IEN59 S IEN59=$$IEN59(ABSBRXI,ABSBRXR,1)
I $$ISRESUB(IEN59) W !?5 D G:Y<1 GETRX1
.I 1 N % D S Y=$S(%=1:Y,%=0:"",%=-1:Y_"R") Q
. . S %=$$RESUBMIT(IEN59)
S Y=+Y
Q Y
IEN59(A,B,C) Q A_"."_$TR($J(B,4)," ","0")_C
ISRESUB(IEN59) ; is this a resubmission of the same prescription/refill?
Q $D(^ABSPT(IEN59))
RESUBMIT(RXI) ; return 1 = yes, submit again 0 = no, do not resubmit
; return -1 if you want to submit a reversal
;
; Cases:
; Processing complete
; If it was paid, invite a reversal.
; Processing not complete
; Check for system backlog and how long ago progress was made.
; Maybe disallow resubmitting the claim based on that.
N RETVAL,X
W !?5,"This prescription has already been processed thru Point of Sale.",!
N STATUS S STATUS=$P(^ABSPT(RXI,0),U,2)
N TIME S TIME=$P(^ABSPT(RXI,0),U,8) ; last update
N REVERSAL S REVERSAL=$G(^ABSPT(RXI,4))
N NOW,%,%H,%I,X D NOW^%DTC S NOW=%
N TIMEDIF S TIMEDIF=$$TIMEDIF^ABSPOSUD(TIME,NOW)
N TIMEDIFI S TIMEDIFI=$$TIMEDIFI^ABSPOSUD(TIME,NOW)
N COMPLETE S COMPLETE=STATUS'<99
I COMPLETE D
. W "Processing completed ",TIMEDIF," ago.",!
. W "The result was ",$$RESULT^ABSPOS6B(RXI),!
. I $$RXPAID^ABSPOSNC(RXI) D
. . W "Last time, the insurer accepted this claim for payment.",!
. . W "If you wish to resubmit the claim with different data,",!
. . W "the paid claim must first be reversed (use the REV option",!
. . W "to reverse paid claims.)",!
. . S RETVAL=0 Q
. . ; This part is not implemented. It would flag this claim for
. . ; reversal and save the trouble of going into the REV option
. . S X=$$YESNO^ABSPOSU3("Do you want to request a REVERSAL? ","NO",0)
. . S RETVAL=$S(X=1:-1,1:0)
. . I RETVAL=0 W !?5,"You should NOT resubmit this claim.",!
. E D
. . S X=$$YESNO^ABSPOSU3("Do you want to resubmit the claim? ","YES",0)
. . S RETVAL=$S(X=1:1,1:0)
. . W " The claim will",$S(RETVAL:"",1:" NOT")," be resubmitted.",!
E D
. W "This claim did not complete processing!",!
. W "The last activity was ",TIMEDIF," ago.",!
. N BACKLOG S BACKLOG=$$BACKLOG^ABSPOSIW ; things waiting to process
. ; The backlog time (weight it some more) plus a few minutes grace
. ; period, at least, before allowing re-submit.
. I TIMEDIFI<1800,BACKLOG>30 D
. . N % S %=BACKLOG+30\60
. . W "There is an estimated backlog in the Point of Sale system",!
. . W "of ",%," minute" W:%>1 "s" W " of processing.",!
. I BACKLOG*1.5+600>TIMEDIFI D S RETVAL=0 Q
. . W "Please wait at least ten minutes before trying ",!
. . W "to resubmit the claim. It may be waiting its turn for ",!
. . W "processing. Or there may be a larger problem that requires",!
. . W "technical support attention.",!
. . S %=$G(^ABSPT(RXI,4))
. . I $P(%,U),'$P(%,U,2) D ; reversal submitted but no response
. . . W !!?10,"REVERSALS: If you just recently submitted a REVERSAL,",!
. . . W ?10,"you may resubmit the claim as soon as the reversal",!
. . . W ?10,"has been completed.",!
. S X=$$YESNO^ABSPOSU3("Are you sure you want to resubmit this claim now? ","NO",0)
. S RETVAL=$S(X=1:1,1:0)
Q RETVAL
ABSPOSIV ; IHS/FCS/DRS - Old-style input ; [ 09/12/2002 10:11 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,10,48**;JUN 21, 2001;Build 38
+2 ; old-style kept for those who want it
+3 ;EP - Branched to here from ABSPOSI
+4 ;----------------------------------------------------------------------
+5 ;IHS/SD/lwj 03/10/04 patch 10
+6 ; Routine adjusted to call ABSPFUNC to retrieve
+7 ; the Prescription Refill NDC value. At some
+8 ; point the call needs to be modified to call APSPFUNC.
+9 ; See ABSPFUNC for details on why call was done.
+10 ;----------------------------------------------------------------------
+11 ;
+12 NEW ABSBRXI,ABSBRXR,ABSBNDC
+13 ; true/false, should we default NDC #?
NEW DEFNDCNO
Begin DoDot:1
+14 NEW X
DO GET515^ABSPOSI(DUZ,.X)
SET DEFNDCNO=$PIECE($GET(X(100)),U)
End DoDot:1
+15 NEW X
SET X=$$READER(99)
+16 ; 03/22/2001
IF X<0
WRITE !,"Because of ""^"", no claims are filed.",!
HANG 3
QUIT
+17 IF X="SCREENMAN"
GOTO ALL1^ABSPOSI
+18 ; 3 = from old style input
NEW ECHO,ORIGIN
SET ECHO=1
SET ORIGIN=3
+19 IF $ORDER(ABSBRXI(""))
DO FILING(ECHO,ORIGIN)
+20 QUIT
FILING(ECHO,ORIGIN) ;EP - from ABSPOSRB
+1 ; with ABSBRXI(*),ABSBRXR(*) set up
+2 IF '$DATA(ECHO)
SET ECHO=1
+3 IF ECHO
WRITE "..."
F5 NEW IEN51
SET IEN51=$$NEWREC^ABSPOSI($ORDER(ABSBRXI(" "),-1),0,ORIGIN)
+1 IF ECHO
WRITE "..."
+2 ; it can't fail
IF '$$INIT^ABSPOSI(IEN51)
IF $$IMPOSS^ABSPOSUE("FM,P","TRI","INIT^ABSPOSI failed",,"FILING",$TEXT(+0))
GOTO F5
+3 IF ECHO
WRITE "..."
+4 ; store local arrays into 9002313.51
DO FILEARAY
+5 IF ECHO
WRITE "..."
+6 ;same FILE^ABSPOSIZ as what Screenman input uses to do filing
DO FILE^ABSPOSIZ(IEN51,ECHO)
+7 IF ECHO
WRITE !
+8 QUIT
TEST ; testing READER
+1 SET X=$$READER
+2 WRITE "Returned value from READER was ",X,!
+3 QUIT
READER(MAXINPUT) ; Get input for Pharmacy POS.
+1 ; Returns 0 if all is well, nonzero if there's any problems.
+2 ; DEFNDC should only be there from my TESTONE entry point
+3 ;
+4 WRITE !!,"Scan the prescription and NDC numbers.",!
+5 WRITE "Press ENTER when done and the claims will be processed.",!
+6 WRITE "Type ^ to stop without sending claims.",!
+7 WRITE !
+8 NEW INDEX
SET INDEX=0
+9 NEW RETVAL
+10 IF '$DATA(MAXINPUT)
SET MAXINPUT=10
+11 FOR INDEX=1:1:MAXINPUT
SET RETVAL=$$READER10
IF RETVAL<1
QUIT
IF RETVAL>1
Begin DoDot:1
+12 SET ABSBRXI(INDEX)=ABSBRXI
+13 SET ABSBRXR(INDEX)=ABSBRXR
+14 SET ABSBNDC(INDEX)=ABSBNDC
End DoDot:1
+15 ; when you pressed ENTER, it didn't echo.
WRITE !
+16 IF RETVAL<0
QUIT RETVAL
+17 IF ABSBRXI="SCREENMAN"
QUIT ABSBRXI
READER99 QUIT 0
+1 ;
+2 ; FILEARAY is used by $$READER as well as some testing programs
+3 ; Moves ABSBRXI(*), ABSBRXR(*), ABSBNDC(*) into the .51 input file,
+4 ; just as if it had been entered through Screenman via ^ABSPOSI
+5 ; Later, call to ABPOSIZ will carry it into .59
+6 ; Needs: IEN51,ABSBRXI(*),ABSBRXR(*),ABSBNDC(*)
FILEARAY ; TO BE MOVED TO ABSPOSIZ: D INCSTAT^ABSPOSUD($T(+0),1)
+1 IF 0
WRITE "At FILEARAY with ",!
Begin DoDot:1
+2 NEW A
SET A=""
FOR
SET A=$ORDER(ABSBRXI(A))
IF 'A
QUIT
Begin DoDot:2
+3 WRITE A,?5,ABSBRXI(A),?20,ABSBRXR(A),?25,ABSBNDC(A),!
End DoDot:2
End DoDot:1
+4 NEW I,FDA,MSG,SUBF,IENS
SET SUBF=9002313.512
+5 FOR I=1:1
IF '$DATA(ABSBRXI(I))
QUIT
Begin DoDot:1
+6 NEW PAT
SET PAT=$PIECE(^PSRX(ABSBRXI(I),0),U,2)
+7 SET IENS=I_","_IEN51_","
+8 SET FDA(SUBF,IENS,.01)=I
+9 SET FDA(SUBF,IENS,.03)=ABSBNDC(I)
+10 SET FDA(SUBF,IENS,1.01)=ABSBRXI(I)
+11 SET FDA(SUBF,IENS,1.02)=ABSBRXR(I)
+12 SET FDA(SUBF,IENS,1.04)=PAT
End DoDot:1
+13 ; next line changed from UPDATE^DIE 09/21/2000
FA5 DO FILE^DIE("","FDA","MSG")
+1 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("FA5^ABSPOSIV",.MSG)
+2 IF $DATA(MSG)
Begin DoDot:1
+3 WRITE !,"Unexpected error in FILEARAY^"_$TEXT(+0),!
+4 DO ZWRITE^ABSPOS("ABSBRXI","ABSBRXR","ABSBNDC","MSG")
End DoDot:1
IF $$IMPOSS^ABSPOSUE("FM","TRI","FILE^DIE failed",,"FILEARAY",$TEXT(+0))
GOTO F5
+5 ; TO BE MOVED TO ABSPOSIZ: D ADDSTAT^ABSPOSUD($T(+0),2,INDEX-1)
+6 QUIT
+7 ;
+8 ; $$SETRXR used by $$READER10 and maybe by others.
+9 ; Called from PAT3^ABSPOS15
SETRXR() ;most recent refill ^PSRX(ien,
QUIT +$ORDER(^PSRX(ABSBRXI,1,"A"),-1)
+1 ;
+2 ; $$DEFNDC used by $$READER10/$$GETNDC and maybe others.
DEFNDC() ;EP - from ABSPOSIW, ABSPOSRB
+1 ;IHS/SD/lwj 03/10/04 patch 10 nxt line rmkd out, new line added
+2 ;I ABSBRXR Q $P($G(^PSRX(ABSBRXI,1,ABSBRXR,0)),U,13)
+3 ;patch 10
IF ABSBRXR
QUIT $$NDCVAL^ABSPFUNC(ABSBRXI,ABSBRXR)
+4 IF '$TEST
QUIT $PIECE($GET(^PSRX(ABSBRXI,2)),U,7)
+5 ;IHS/SD/lwj 03/10/04 patch 10 end change
+6 ;
READER10() ; Get the inputs
+1 ; INDEX = which one you're on (1 = first, 2 = second, etc.)
+2 ; Return -1 if the user wants out
+3 ; Return 0 if input is complete ("" response to Prescription #)
+4 ; Return >0,<1 if some kind of problem with input (a try-again)
+5 ; Return >1 if all is well as good for storage
+6 ; Sets ABSBRXI,ABSBRXR,ABSBNDC
+7 ;
+8 ; Prompt user for "Prescription: "
+9 ; Set ABSBRXI=ien for ^PSRX(ien,
+10 ;
READER11 ; branch back if "SCREENMAN" entered too late
+1 ; sets ABSBRXR, too
SET ABSBRXI=$$GETRX()
+2 IF ABSBRXI="SCREENMAN"
IF INDEX=1
QUIT ABSBRXI
Begin DoDot:1
+3 WRITE !,"Typing SCREENMAN has to be done at the very beginning.",!
+4 WRITE "For now, you're stuck in this old-style input.",!
+5 WRITE "Answer with ^ to get out without doing anything.",!
End DoDot:1
GOTO READER11
+6 ;
+7 WRITE !
+8 IF ABSBRXI<1
QUIT $SELECT(ABSBRXI["^":-1,ABSBRXI="":0,1:0.01)
+9 ;
+10 SET ABSBNDC=$$GETNDC^ABSPOSIW()
+11 WRITE !
+12 ;ZW ABSBNDC
+13 ; 03/22/2001 ;Q 0.04
IF 'ABSBNDC
WRITE !,"Try again.",!
HANG 2
GOTO READER11
+14 ;
READER19 ; return big #, since all is well for storage
QUIT ABSBRXI
+1 ; with ABSBRXR, ABSBNDC
+2 ;
+3 ; Compute time difference
TDIF(H0,H1) QUIT $PIECE(H1,",")-$PIECE(H0,",")*86400+$PIECE(H1,",",2)-$PIECE(H0,",",2)
+1 ;
GETRX() ;EP - from ABSPOS6L,ABSPOS6M
+1 ;Prompt - get prescription
+2 ; Return "" or "^" or "^^" or prescription IEN.
+3 ; Return -1 (?) if prescription not found.
+4 ; Returns prescription IEN_"R" if you are requesting a reversal.
+5 ; ^^^^ that last part isn't implemented yet.
+6 NEW X,Y,PT,DG,DIC
GETRX1 ;
+1 SET X=$$FREETEXT^ABSPOSU2("Prescription: ",,1,1,31,$GET(DTIME))
+2 ;Q:X="^" "^" Q:X="" X
IF "^^"[X
QUIT X
+3 ;
+4 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwyxz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+5 IF $EXTRACT("SCREENMAN",1,$LENGTH(X))=X
QUIT "SCREENMAN"
+6 ;
+7 ; Bar code labels at ANMC have a prefix, "-", and the internal #
+8 IF X["-"
SET X=$PIECE(X,"-",2)
SET X="`"_X
+9 ;
+10 ; If input was pure numeric, look at parameter to determine whether it
+11 ; is an internal or external prescription number. If internal,
+12 ; prefix the "`". See too the "+X" to strip leading zeroes. This
+13 ; might be the case with a bar code input.
+14 ;
+15 IF X?1N.N
Begin DoDot:1
+16 IF $PIECE($GET(^ABSP(9002313.99,1,"INPUT")),U)=0
SET X="`"_+X
+17 ; else it's an external number; leave it alone
End DoDot:1
+18 ;
+19 ; Maybe typed RX followed by an RX external number
+20 ;
+21 IF $PIECE(X," ")="RX"
SET X=+$PIECE(X," ",2)
+22 ;
+23 SET DIC="^PSRX("
SET DIC(0)="N"
DO ^DIC
+24 IF Y<1
Begin DoDot:1
+25 WRITE !,"INPUT - Prescription "_X_" not found.",!
End DoDot:1
GOTO GETRX1
+26 SET Y=+Y
+27 SET X=$GET(^PSRX(Y,0))
+28 SET PT=$PIECE(X,U,2)
SET DG=$PIECE(X,U,6)
+29 IF PT]""
WRITE " ",$PIECE($GET(^DPT(PT,0)),U)
+30 IF DG]""
WRITE " ",$PIECE($GET(^PSDRUG(DG,0)),U)
+31 SET ABSBRXI=Y
SET ABSBRXR=$$SETRXR
+32 NEW IEN59
SET IEN59=$$IEN59(ABSBRXI,ABSBRXR,1)
+33 IF $$ISRESUB(IEN59)
WRITE !?5
Begin DoDot:1
+34 IF 1
NEW %
Begin DoDot:2
+35 SET %=$$RESUBMIT(IEN59)
End DoDot:2
SET Y=$SELECT(%=1:Y,%=0:"",%=-1:Y_"R")
QUIT
End DoDot:1
IF Y<1
GOTO GETRX1
+36 SET Y=+Y
+37 QUIT Y
IEN59(A,B,C) QUIT A_"."_$TRANSLATE($JUSTIFY(B,4)," ","0")_C
ISRESUB(IEN59) ; is this a resubmission of the same prescription/refill?
+1 QUIT $DATA(^ABSPT(IEN59))
RESUBMIT(RXI) ; return 1 = yes, submit again 0 = no, do not resubmit
+1 ; return -1 if you want to submit a reversal
+2 ;
+3 ; Cases:
+4 ; Processing complete
+5 ; If it was paid, invite a reversal.
+6 ; Processing not complete
+7 ; Check for system backlog and how long ago progress was made.
+8 ; Maybe disallow resubmitting the claim based on that.
+9 NEW RETVAL,X
+10 WRITE !?5,"This prescription has already been processed thru Point of Sale.",!
+11 NEW STATUS
SET STATUS=$PIECE(^ABSPT(RXI,0),U,2)
+12 ; last update
NEW TIME
SET TIME=$PIECE(^ABSPT(RXI,0),U,8)
+13 NEW REVERSAL
SET REVERSAL=$GET(^ABSPT(RXI,4))
+14 NEW NOW,%,%H,%I,X
DO NOW^%DTC
SET NOW=%
+15 NEW TIMEDIF
SET TIMEDIF=$$TIMEDIF^ABSPOSUD(TIME,NOW)
+16 NEW TIMEDIFI
SET TIMEDIFI=$$TIMEDIFI^ABSPOSUD(TIME,NOW)
+17 NEW COMPLETE
SET COMPLETE=STATUS'<99
+18 IF COMPLETE
Begin DoDot:1
+19 WRITE "Processing completed ",TIMEDIF," ago.",!
+20 WRITE "The result was ",$$RESULT^ABSPOS6B(RXI),!
+21 IF $$RXPAID^ABSPOSNC(RXI)
Begin DoDot:2
+22 WRITE "Last time, the insurer accepted this claim for payment.",!
+23 WRITE "If you wish to resubmit the claim with different data,",!
+24 WRITE "the paid claim must first be reversed (use the REV option",!
+25 WRITE "to reverse paid claims.)",!
+26 SET RETVAL=0
QUIT
+27 ; This part is not implemented. It would flag this claim for
+28 ; reversal and save the trouble of going into the REV option
+29 SET X=$$YESNO^ABSPOSU3("Do you want to request a REVERSAL? ","NO",0)
+30 SET RETVAL=$SELECT(X=1:-1,1:0)
+31 IF RETVAL=0
WRITE !?5,"You should NOT resubmit this claim.",!
End DoDot:2
+32 IF '$TEST
Begin DoDot:2
+33 SET X=$$YESNO^ABSPOSU3("Do you want to resubmit the claim? ","YES",0)
+34 SET RETVAL=$SELECT(X=1:1,1:0)
+35 WRITE " The claim will",$SELECT(RETVAL:"",1:" NOT")," be resubmitted.",!
End DoDot:2
End DoDot:1
+36 IF '$TEST
Begin DoDot:1
+37 WRITE "This claim did not complete processing!",!
+38 WRITE "The last activity was ",TIMEDIF," ago.",!
+39 ; things waiting to process
NEW BACKLOG
SET BACKLOG=$$BACKLOG^ABSPOSIW
+40 ; The backlog time (weight it some more) plus a few minutes grace
+41 ; period, at least, before allowing re-submit.
+42 IF TIMEDIFI<1800
IF BACKLOG>30
Begin DoDot:2
+43 NEW %
SET %=BACKLOG+30\60
+44 WRITE "There is an estimated backlog in the Point of Sale system",!
+45 WRITE "of ",%," minute"
IF %>1
WRITE "s"
WRITE " of processing.",!
End DoDot:2
+46 IF BACKLOG*1.5+600>TIMEDIFI
Begin DoDot:2
+47 WRITE "Please wait at least ten minutes before trying ",!
+48 WRITE "to resubmit the claim. It may be waiting its turn for ",!
+49 WRITE "processing. Or there may be a larger problem that requires",!
+50 WRITE "technical support attention.",!
+51 SET %=$GET(^ABSPT(RXI,4))
+52 ; reversal submitted but no response
IF $PIECE(%,U)
IF '$PIECE(%,U,2)
Begin DoDot:3
+53 WRITE !!?10,"REVERSALS: If you just recently submitted a REVERSAL,",!
+54 WRITE ?10,"you may resubmit the claim as soon as the reversal",!
+55 WRITE ?10,"has been completed.",!
End DoDot:3
End DoDot:2
SET RETVAL=0
QUIT
+56 SET X=$$YESNO^ABSPOSU3("Are you sure you want to resubmit this claim now? ","NO",0)
+57 SET RETVAL=$SELECT(X=1:1,1:0)
End DoDot:1
+58 QUIT RETVAL
