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

ABSPOSR3.m

Go to the documentation of this file. 
  1. ABSPOSR3 ; IHS/FCS/DRS - silent claim submitter ;    
  1.  ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1.  Q  ; continuation of ABSPOSR1
  1. GETFIELD(X)        Q $$GETFIELD^ABSPOSR1(X)
  1. MONITOR ;EP -
  1.  N DOLLARH S DOLLARH(2)=+$H
  1.  F  D  Q:$$STOP
  1.  . D HANG
  1.  . S DOLLARH(1)=DOLLARH(2)
  1.  . S DOLLARH(2)=+$H
  1.  . I DOLLARH(1)=DOLLARH(2) D
  1.  . . D POLL
  1.  . E  D  ; $H flipped over to a new day
  1.  . . D STOPIT^ABSPOSR1(0,1) ; stop the background job (no echo, no wait)
  1.  . . S RESTART=1 ; flag - we want to start it up again
  1.  D SETFIELD^ABSPOSR1(120.03,2) ; mark that we stopped
  1.  Q
  1. HANG N X S X=$$GETFIELD(120.04)
  1.  H $S(X>30:X,1:30) Q  ; enforce minimum of 30 seconds between polls
  1. STOP() Q $$GETFIELD(120.03)=1 ; returns True if value 1 = Stop requested
  1. LOG(X) D LOG^ABSPOSL(X) Q
  1. POLL ; here's where we poll and see what's new
  1.  D LOG("Polling")
  1.  ; What was the last time we polled?
  1.  N LASTTIME S LASTTIME=$$GETFIELD(120.02)
  1.  ; And update it to say "last time we did it was now"
  1.  D SETFIELD^ABSPOSR1(120.02,"NOW","E")
  1.  ; Reach back some more beyond that time
  1.  ;  (this is to allow for delays in filing)
  1.  S LASTTIME=$$TADDSECS^ABSPOSUD(LASTTIME,-$$GETFIELD(120.05))
  1.  N TIME,ENDTIME S TIME=LASTTIME,ENDTIME=""
  1.  D WORKLIST(TIME,ENDTIME,$$MYLIST)
  1.  D PROCESS($$MYLIST)
  1.  Q
  1.  ; The work list for this routine is maintained in
  1.  ;  ^ABSPECP("ABSPOSR1",TIME,ACTION,RXI,RXR)
  1.  ;   ACTION=1 for claims, ACTION=2 for reversals
  1.  ;
  1. MYLIST() Q "^ABSPECP("""_$T(+0)_""")"
  1. KMYLIST K ^ABSPECP($T(+0)) Q
  1. SEELIST(TIME,ENDTIME)       ;
  1.  I '$D(TIME) S TIME=T1,ENDTIME=T2
  1.  W "Probing for time range ",TIME," through ",ENDTIME,"...",!
  1.  K TMP D WORKLIST(TIME,ENDTIME,"TMP")
  1.  N Q,I S Q="TMP" F I=0:1 S Q=$Q(@Q) Q:Q=""  D
  1.  . I I<10 W Q,!
  1.  . I I=10 W "...and more... ZW TMP to see them all",!
  1.  W "Total = ",I," entr",$S(I=1:"y",1:"ies")
  1.  Q
  1. NEXT(N) ; advances T1,T2 ; come in with T1,T2 already set
  1.  S T1=$P(^ABSP(9002313.99,"ABSPOSR1"),U)
  1.  S T2=$$T2("AL",T1,N)
  1.  D SEELIST(T1,T2) W !
  1.  D ZWRITE^ABSPOS("T1","T2")
  1.  Q
  1. T2(INDEX,T1,N) ;  sets T2 to include N transactions from given T1
  1.  ; may be more than N if there are several at the exact same time
  1.  N T S T=T1
  1.  F  D  Q:N<1  Q:T=""
  1.  . S A=""
  1.  . F  S A=$O(^PSRX(INDEX,T,A)) Q:A=""  D  Q:N<1
  1.  . . S B=""
  1.  . . F  S B=$O(^PSRX(INDEX,T,A,B)) Q:B=""  D
  1.  . . . S N=N-1
  1.  . I N>0 S T=$O(^PSRX("AL",T))
  1.  S T2=T
  1.  Q:$Q T2 Q
  1. WORKLIST(TIME,ENDTIME,LISTROOT) ; EP - from ABSPOSR4
  1.  ; callable from outside:
  1.  ; given TIME = starting time to examine
  1.  ; given ENDTIME="" to go through end, else ending date.time
  1.  ; Be careful to process them in order!
  1.  I $$GETFIELD(120.07)="" D DEFAULTS^ABSPOSR1
  1.  N CLAIM,CANCEL S CLAIM=$$GETFIELD(120.06),CANCEL=$$GETFIELD(120.07)
  1.  N INDEX F INDEX=CLAIM,CANCEL D
  1.  . N T S T=TIME
  1.  . F  D  Q:T=""  I ENDTIME,T>ENDTIME Q
  1.  . . N RXI,RXR
  1.  . . S RXI="" F  S RXI=$O(^PSRX(INDEX,T,RXI)) Q:RXI=""  D
  1.  . . . S RXR="" F  S RXR=$O(^PSRX(INDEX,T,RXI,RXR)) Q:RXR=""  D
  1.  . . . . D WORK1
  1.  . . S T=$O(^PSRX(INDEX,T)) ; then get the next time
  1.  Q
  1. WORK1 ; we have LISTROOT,CLAIM,CANCEL,INDEX,T,RXI,RXR
  1.  ; put it on the work list
  1.  S @LISTROOT@(T,$S(INDEX=CLAIM:1,INDEX=CANCEL:2),RXI,RXR)=""
  1.  Q
  1. PROCESS(WORKLIST)  ; EP - from ABSPOSR4
  1.  ; where WORKLIST was constructed by the paragraph, above
  1.  N TIME,TYPE,RXI,RXR
  1.  S TIME="" F  S TIME=$O(@WORKLIST@(TIME)) Q:'TIME  D
  1.  . F TYPE=1,2 D
  1.  . . S RXI="" F  S RXI=$O(@WORKLIST@(TIME,TYPE,RXI)) Q:RXI=""  D
  1.  . . . S RXR="" F  S RXR=$O(@WORKLIST@(TIME,TYPE,RXI,RXR)) Q:RXR=""  D
  1.  . . . . D PROC1
  1.  Q
  1. TURNEDON() Q 1
  1. PROC1 ; given WORKLIST,TIME,TYPE,RXI,RXR
  1.  ; MSG for logging: set to null if you don't want a message
  1.  ; (we'll probably change a lot of these to "" as we gain confidence)
  1.  N X,MSG,KILL S MSG=RXI_","_RXR
  1.  I TYPE=1 D  ; new claim
  1.  . S MOREDATA("ORIGIN")=6
  1.  . S MOREDATA("DO NOT RESUBMIT")=1
  1.  . I $$TURNEDON F  D  Q:X  Q:'$$IMPOSS^ABSPOSUE("P","RIT","$$CLAIM^ABSPOSRX failed",,,$T(+0))
  1.  . . S X=$$CLAIM^ABSPOSRX(RXI,RXR,.MOREDATA)
  1.  . . Q:X  ; success
  1.  . . D LOG("Unexpected failure of CLAIM^ABSPOSRX")
  1.  . . D LOG("X="_X_",RXI="_RXI_",RXR="_RXR)
  1.  . . S X=0
  1.  . E  D
  1.  . . D LOG("Testing - skipping $$CLAIM^ABSPOSRX("_RXI_","_RXR_",.MOREDATA)")
  1.  . S KILL=1
  1.  E  I TYPE=2 D  ; reversal
  1.  . I $$TURNEDON F  D  Q:X  Q:'$$IMPOSS^ABSPOSUE("P","RIT","$$UNCLAIM^ABSPOSRX failed",,,$T(+0))
  1.  . . S X=$$UNCLAIM^ABSPOSRX(RXI,RXR) Q:X  ; success
  1.  . . D LOG("Unexpected failure of CLAIM^ABSPOSRX")
  1.  . E  D
  1.  . . D LOG("Testing - skipping $$UNCLAIM^ABSPOSRX("_RXI_","_RXR_")")
  1.  . . S X=1
  1.  . S KILL=1
  1.  E  D IMPOSS^ABSPOSUE("P","RIT","TYPE="_TYPE,"at bottom of loop",,$T(+0))
  1.  I KILL D
  1.  . K @WORKLIST@(TIME,TYPE,RXI,RXR)
  1.  Q
  1. LASTUP(RXI,RXR)    Q $$LASTUP59^ABSPOSRX(RXI,RXR)