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

ABSPOSIV.m

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