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

ABSPOSIZ.m

Go to the documentation of this file. 
  1. ABSPOSIZ ; IHS/FCS/DRS - Filing with .51,.59 ;    [ 11/04/2002  2:01 PM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,6,23,34,48**;JUN 01, 2001;Build 38
  1.  Q
  1.  ; Locking:
  1.  ; 1. Locking this routine's code.
  1.  ;    Done during FILE1
  1.  ;    May be delays due to question-and-answer I/O!!!
  1.  ; 2. Locking 9002313.59 - when obtaining a new entry and filing data.
  1.  ;    No intervening delays as that would hold up all POS activity
  1.  ;---
  1.  ; IHS/SD/lwj 11/03/02  
  1.  ; In Oklahoma, POS will go into a run away mode if there has been
  1.  ; any type of stranded claim for Oklahoma Medicaid.  This is due in
  1.  ; to the "special" logic that is in place for the Oklahoma Medicaid
  1.  ; claims.  Basically, it continues to task itself again and again
  1.  ; trying to clear the claims - this overflows task man.  To try and
  1.  ; "slow" this some, we are going to add some logic to this program
  1.  ; that will slow the tasking a little bit.  This will effect
  1.  ; everything, not just Oklahoma, but we don't think the slow down
  1.  ; won't harm anything at all.  The changes were originate by 
  1.  ; Patrick Cox, and have been in test with Talequah since early
  1.  ; 2002.
  1.  ;---
  1.  ;IHS/SD/lwj 7/17/03
  1.  ; Need to add a clean up routine for the 5.1 DUR segment
  1.  ;---
  1.  ;IHS/SD/RLT - 06/21/07 - 10/18/07 - Patch 23
  1.  ; Added cleanup routine for DIAGNOSIS CODE in CLINICAL segment
  1.  ;---
  1. LOCK() L +^TMP("ABSPOSIZ"):300 Q $T
  1. UNLOCK L -^TMP("ABSPOSIZ") Q
  1. LOCK59() L +^ABSPT:300 Q $T
  1. UNLOCK59 L -^ABSPT Q
  1. FILE(IEN,ECHO) ;EP - from ABSPOSI, ABSPOSIV
  1.  ; <PF1> E was hit - so we make these claims official
  1.  ; ^ABSP(9002313.51,IEN,...) -> 9002313.59 or wherever
  1.  I '$D(ECHO) S ECHO=1
  1.  N ENTRY S ENTRY=0
  1.  N ABSPOSQ1 S ABSPOSQ1=0 ; set to nonzero if you need background job
  1.  D DELEMPTY ; delete empty entries from the multiple
  1.  I '$P($G(^ABSP(9002313.51,IEN,2,0)),U,4) D  G FZ
  1.  . I ECHO W "Nothing entered..."
  1.  I ECHO W "Submitting claims...",!
  1.  F  S ENTRY=$O(^ABSP(9002313.51,IEN,2,ENTRY)) Q:'ENTRY  D
  1.  . I ECHO D QUICK51(IEN,ENTRY)
  1.  . F  Q:$$LOCK  Q:'$$IMPOSS^ABSPOSUE("L","RTI","Single-thread filing through ABSPOSIZ",,"FILE",$T(+0))
  1.  . D INSUR(IEN,ENTRY,ECHO)
  1.  . D CLNDUR^ABSPOSIH(IEN,ENTRY)   ;IHS/SD/lwj 7/17/03 patch 6
  1.  . D CLNDIAG^ABSPOSII(IEN,ENTRY)  ;IHS/SD/RLT - 06/21/07 - 10/18/07 - Patch 23
  1.  . D FILE1(IEN,ENTRY,ECHO)
  1.  . D UNLOCK
  1.  ; start background job if necessary
  1.  I ABSPOSQ1 D TASK
  1. FZ I ECHO W "...done.",! H 2
  1.  Q
  1. TASK ;EP - from ABSPOS2D,ABSPOS6D,ABSPOSQ1,ABSPOSQ4,ABSPOSU
  1.  ;
  1.  ;IHS/SD/lwj 11/03/02 on behalf of IHS/OKCAO/POC 1/25/2002
  1.  ; This is where we are going to slow the tasking down a little. We will
  1.  ; attempt to wait 2 second in between tasking the job again.  This 
  1.  ; doesn't sound like much, but when it's run away, this will cut the 
  1.  ; submittals by over half if not more.
  1.  ;
  1.  ; begin changes
  1.  N ABSPQQQT
  1.  S ABSPQQQT=0
  1.  D
  1.  . N CHECK
  1.  . S CHECK=$G(^ABSPECP("CHECKTIM"))  ;last submittal time
  1.  . S:$$FMDIFF^XLFDT($$NOW^XLFDT,CHECK,2)'>2 ABSPQQQT=1
  1.  Q:ABSPQQQT
  1.  S ^ABSPECP("CHECKTIM")=$$NOW^XLFDT
  1.  ;
  1.  ;IHS/SD/lwj 11/03/02  end changes
  1.  ;
  1.  N X,Y,%DT
  1.  S X="N",%DT="ST" D ^%DT
  1.  D TASKAT(Y)
  1.  Q
  1. TASKAT(ZTDTH)         ;EP - from above and from ABSPOSQS
  1.  ; ZTDTH = time when you want COMMS^ABSPOSQ3 to run
  1.  ; called from TASK, above, normally
  1.  ; no??: called here from ABSPOSQ3 when it's requeueing itself for 
  1.  ; retry after a dial-out error condition
  1.  ;   ABSPOSQ3 requeues itself via TASK^ABSPOSQ2, not here
  1.  ;N (DUZ,TIME,ZTDTH)
  1.  N ZTRTN,ZTIO
  1.  S ZTRTN="LOOP^ABSPOSQ1",ZTIO=""
  1.  D ^%ZTLOAD
  1.  Q
  1.  ; KScratch ;Kill scratch globals
  1.  ;K ^ABSPECX($J,"R")
  1. DELEMPTY ; the multiple probably has some empty entries - delete them
  1.  ; IEN is inherited from caller
  1.  N FDA,MSG,FN,ENTRY S FN=9002313.512,ENTRY=0
  1.  F  S ENTRY=$O(^ABSP(9002313.51,IEN,2,ENTRY)) Q:'ENTRY  D
  1.  . N X,Y S X=^ABSP(9002313.51,IEN,2,ENTRY,0),Y=$G(^(1))
  1.  . I X?1N.N."^",Y?."^" D  ; see Note 1, below
  1.  . . S FDA(FN,ENTRY_","_IEN_",",.01)=""
  1.  Q:'$D(FDA)  ; nothing to delete
  1. D5 D FILE^DIE("","FDA","MSG")
  1.  I $D(MSG) D LOG^ABSPOSL2("D5^ABSPOSIZ",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  Q:'$D(MSG)  ; success
  1.  D ZWRITE^ABSPOS("FDA","MSG")
  1.  G D5:$$IMPOSS^ABSPOSUE("FM","TRI","FILE^DIE failed",,"DELEMPTY",$T(+0))
  1.  Q
  1.  ; Note 1.  In DELEMPTY, the test for an empty node:
  1.  ;  piece 1 is the entry number, uneditable, ?1N.N
  1.  ;  pieces 2ff may be present but null - apparently, just visiting
  1.  ;   a field (e.g., pressing down arrow from NDC number)
  1.  ; And also need to test for no fields in the ^(1) node ; 09/21/2000
  1.  ;   could lead to filling in some empty values)
  1. INSUR(IEN,ENTRY,ECHO)        ; ^ABSP(9002313.51,IEN,2,ENTRY,"I",*)
  1.  ; need to move it into ^ABSP(9002313.51,IEN,2,ENTRY,6)=PINS data
  1.  ; and ^ABSP(9002313.51,IEN,2,ENTRY,7)=insurer IENs
  1.  N N S N=0 F  S N=$O(^ABSP(9002313.51,IEN,2,ENTRY,"I",N)) Q:'N  D
  1.  . N X S X=^ABSP(9002313.51,IEN,2,ENTRY,"I",N,0)
  1.  . I $P(X,U,2) D  ; ORDER is given
  1.  . . N ORDER S ORDER=$P(X,U,2)
  1.  . . S $P(^ABSP(9002313.51,IEN,2,ENTRY,6),U,ORDER)=$P(X,U,4) ; PINS
  1.  . . S $P(^ABSP(9002313.51,IEN,2,ENTRY,7),U,ORDER)=$P(X,U,3) ;ins ien
  1.  ; Delete the entire INS SEL SCRATCH field - it's no longer needed
  1.  K ^ABSP(9002313.51,IEN,2,ENTRY,"I")
  1.  ; the following fails because the field is a multiple
  1.  ;N FDA,MSG,FN
  1.  ;S FDA(9002313.512,ENTRY_","_IEN_",",100)=""
  1.  ;D FILE^DIE("","FDA","MSG")
  1.  ;I $D(MSG) D LOG^ABSPOSL2("INSUR^ABSPOSIZ",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  ;I $D(MSG) W "at INSUR^",$T(+0),! ZW MSG IMPOSS^ABSPOSUE call, too
  1.  Q
  1. FILE1(IEN,ENTRY,ECHO)   ; ^ABSP(9002313.51,IEN,2,ENTRY,...)
  1.  N INPUT M INPUT=^ABSP(9002313.51,IEN,2,ENTRY) ; convenience
  1.  N ORIGIN S ORIGIN=$P(^ABSP(9002313.51,IEN,0),U,3)
  1.  N ABSPUSR S ABSPUSR=$P(^ABSP(9002313.51,IEN,0),U,2) ;IHS/OIT/SCR 082709 patch 34
  1.  N X S X=$P(INPUT(0),U,2)
  1.  ; X can be any of the following:
  1.  ;   `#     # points to ^PSRX(#,
  1.  ;  (still have to work out the visit file details)
  1.  D REMAP
  1.  D FILERX
  1.  Q
  1. REMAP ; do any needed adjusing of INPUT(*) to handle postage, supplies, etc.
  1.  Q
  1. ISRX() ; return pointer to ^PSRX if true, else return ""
  1.  N X S X=$P(INPUT(1),U) I 'X Q ""
  1.  I $P(INPUT(0),U,3)?1"POSTAGE".E Q ""
  1.  Q X
  1. ISPOST() ; return pointer to ^PSRX if true, else return ""
  1.  N X S X=$P(INPUT(1),U) I 'X Q ""
  1.  I $P(INPUT(0),U,3)?1"POSTAGE".E Q X
  1.  Q ""
  1. ISVISIT() ; return pointer to visit if true, else return ""
  1.  ; (this is for non-prescription items)
  1.  N X S X=$P(INPUT(1),U) I X Q "" ; has ^PSRX pointer, so ret false
  1.  Q $P(INPUT(1),U,6)
  1. FILERX ; EVERYTHING is filed here: postage, supplies, as well as RX's
  1.  ;
  1.  ;  If it's being actively processed now, do not allow it to be
  1.  ;  submitted again here.
  1.  ;
  1.  N DEBUG S DEBUG=0 ;(DUZ=120&(DUZ(2)=1859))
  1.  N IEN59 S IEN59=$$IEN59^ABSPOSIY
  1.  ;I DEBUG W ?10,"IEN59=",IEN59,!
  1. RXA I $$ACTIVE59(IEN59) Q:'$$ACTIVEWT^ABSPOSIY(IEN59,IEN,ENTRY)  D  G RXA
  1.  . D UNLOCK H 30
  1.  . F  Q:$$LOCK  Q:'$$IMPOSS^ABSPOSUE("L","RTI","LOCK transaction record for IEN59="_IEN59,,"RXA",$T(+0))
  1.  N X
  1.  ;
  1.  ;  If it's been deleted...
  1.  ;  Let it through for now.
  1.  ;  We're catching deleted ones in ABSPOSRB, so anything marked for
  1.  ;  deletion that reaches here was input manually.
  1.  ;S X=$$RXDEL^ABSPOS(RXI,RXR) I X D  I X=1 Q
  1.  ;
  1.  ;  If it's been submitted in the past, 
  1.  ;    mention that fact and look at what happened to it.
  1.  ;  case 1:   Payable    or   Duplicate of a paid claim   or  Paper
  1.  ;     Invite a reversal
  1.  ;
  1.  ;   NOTE  for the indefinite interim:
  1.  ;       We don't yet have it set up to invite an easy reversal here.
  1.  ;       We are letting paper claims go through and be resubmitted.
  1.  ;
  1.  ;  case 2:   Not paid
  1.  ;     Allow it to be submitted again here.
  1.  ;
  1.  S X=$$RXPAID^ABSPOSIY(IEN,ENTRY) I X D  I X=1!(X=3) Q
  1.  . I '$G(ECHO) Q  ; not interactive, so just skip it
  1.  . W ?5,"This claim has already been submitted.",!
  1.  . I X=1!(X=3) D
  1.  . . W ?5,"It was an electronic claim and it was "
  1.  . . W $S(X=1:"paid",X=3:"captured."),!
  1.  . I X=2 D
  1.  . . W ?5,"It was flagged to be sent on a paper claim.",!
  1.  . . W ?5,"It will be processed again, as if it had been reversed.",!
  1.  . I X=1 D
  1.  . . W ?5,"You must first reverse the original claim,",!
  1.  . . W ?5,"and then resubmit it.  RES will do it all for you.",!
  1.  . D PRESSANY^ABSPOSU5() ; $$WANTREV^ABSPOSIY not yet implemented
  1.  ;
  1.  ; Not active, not submitted in the past - SUBMIT IT NOW
  1.  ; Create a .59 entry, fill in the pieces
  1.  ;
  1. L59A I '$$LOCK59 G L59A:$$IMPOSS^ABSPOSUE("L","RTI","LOCK transaction for IEN59="_IEN59,,"L59A",$T(+0))
  1.  I $$EXIST59(IEN59) D
  1.  . D CLEAR59(IEN59)
  1.  E  D
  1. L59N . I $$NEW59(IEN59)'=IEN59 G L59N:$$IMPOSS^ABSPOSUE("FM,DB,P","RTI","init new transaction record for IEN59="_IEN59,,"L59N",$T(+0))
  1.  ;I $$SETUP59^ABSPOSIY(IEN59,ORIGIN) S ABSPOSQ1=ABSPOSQ1+1
  1.  I $$SETUP59^ABSPOSIY(IEN59,ORIGIN,ABSPUSR) S ABSPOSQ1=ABSPOSQ1+1 ;IHS/OIT/SCR 081709 patch 34
  1.  D UNLOCK59
  1.  Q
  1. EXIST59(N)         ;
  1.  N X
  1.  S X=$$FIND1^DIC(9002313.59,,"QX","`"_N)
  1.  Q $S(X>0:X,X=0:0)
  1. NEW59(N) ; send N = desired IEN in file 9002313.59
  1.  N FLAGS,FDA,IEN,MSG,X,FN
  1.  S FLAGS="" ; internal values
  1.  N X S X="+1,"
  1.  S FN=9002313.59
  1.  S (IEN(1),FDA(FN,X,.01))=N
  1.  D UPDATE^DIE(FLAGS,"FDA","IEN","MSG")
  1.  I $D(MSG) D LOG^ABSPOSL2("NEW59^ABSPOSIZ",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  I $D(MSG) Q 0
  1.  Q IEN(1)
  1. CLEAR59(N)         ;
  1.  ; deletes all values except the value in the .01 field
  1.  N FN,X,FLAGS,FDA,MSG,FIELD
  1.  S FN=9002313.59,X=N_",",FLAGS=""
  1.  S FIELD=.01 ; $O will skip past this field
  1.  F  S FIELD=$O(^DD(FN,FIELD)) Q:'FIELD  D
  1.  . ; Erase every field except RESULT TEXT, RESUBMIT AFTER REVERSAL
  1.  . I FIELD=202!(FIELD=1.12) D
  1.  . . ;S FDA(FN,X,FIELD)=$E("[Previously: "_$$GET1^DIQ(FN,X,FIELD)_"]",1,200)
  1.  . E  S FDA(FN,X,FIELD)="" ; delete
  1.  D FILE^DIE(FLAGS,"FDA","MSG")
  1.  I $D(MSG) D LOG^ABSPOSL2("CLEAR59^ABSPOSIZ",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  D PREVISLY(N) ; for result text field 202
  1.  Q
  1. PREVISLY(IEN59)    ;EP ; Bracket result text with [Previously: ], if not null
  1.  ; Called by REVERSE^ABSPOS6D, too
  1.  N X S X=$$GET1^DIQ(9002313.59,IEN59,202)
  1.  Q:X=""
  1.  S X=$E("[Previously: "_X_"]",1,200)
  1.  N FN,FDA,MSG S FDA(9002313.59,IEN59_",",202)=X
  1. PR5 D FILE^DIE("","FDA","MSG")
  1.  I $D(MSG) D LOG^ABSPOSL2("PR5^ABSPOSIZ",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  Q:'$D(MSG)  ;;; /IHS/OIT/RAM ; YES, I REALIZE THIS IS STARTING 'SPAGHETTI CODE' ISSUES... TRYING TO KEEP WITH 'MINIMAL CHANGES' FOR NOW.
  1.  D ZWRITE^ABSPOS("FDA","MSG","IEN59","X")
  1.  G PR5:$$IMPOSS^ABSPOSUE("FM","TRI","FILE^DIE failed",,"PREVISLY",$T(+0))
  1.  Q
  1. ACTIVE59(N)        ; is ^ABSPT(N) active now?
  1.  F  Q:$$LOCK59  Q:'$$IMPOSS^ABSPOSUE("L","RTI","LOCK of transaction for IEN59="_IEN59,,"ACTIVE59",$T(+0))
  1.  N Z S Z=$G(^ABSPT(N,0))
  1.  D UNLOCK59
  1.  I Z="" Q 0 ; easy - there's no such record
  1.  I $P(Z,U,2)=99 Q 0 ; status = complete
  1.  I $$TIMEDIFI^ABSPOSUD($P(Z,U,8),$$NOW)>604800 Q 0  ; Must have been stranded over a week?  Let it through.
  1.  Q 1 ; status not complete
  1. NOW() N %,%H,%I,X D NOW^%DTC Q %
  1. QUICK51(IEN,ENTRY)          ; ^ABSP(9002313.51,IEN,2,ENTRY,...)
  1.  N X
  1.  S X=^ABSP(9002313.51,IEN,2,ENTRY,0)
  1.  W $P(X,U,4)," ",$P(X,U,2)," ",$P(X,U,5)," ",$P(X,U,7),!
  1.  W !
  1.  Q