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