ABSPOS6D ; IHS/FCS/DRS - user screen subrous ;
;;1.0;PHARMACY POINT OF SALE;**14,18,37,38,40,41,46**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;IHS/SD/RLT - 8/24/06 - Patch 18
; Changed code so rejected reversals can be resubmitted.
Q
PRINTALL ; protocol ABSP P1 PRINT ALL ; print all patients' results
N IO I '$$DEVICE G PRINT99
U $P D:IO=$P FULL^VALM1 U IO
D PRINTHDR
N A S A="" F S A=$O(@VALMAR@(A)) Q:'A D PRINTA(A)
G PRINT9
PRINTHDR ; print a header
W VALM("TITLE")," "
N %,%H,%I,X,Y D NOW^%DTC S Y=% X ^DD("DD") W Y,!!
N A S A="" F S A=$O(VALMHDR(A)) Q:A="" W VALMHDR(A),!
W !
Q
PRINTA(A) ; print line A
; How could you tell whether this is a patient line or a prescription
; line? And which patient or prescription is represented?
; Look at @DISPLINE(n)=patname or patname^rxi
; Look at @VALMIDX@(n,patien), @VALMIDX@(n,patien,rxien)
I '$D(IOM) N IOM S IOM=80
N X D
.I $D(@VALMAR@(A,0)) S X=@VALMAR@(A,0)
.E S X="(? Line "_A_" is missing?)"
.F Q:$E(X,$L(X))'=" " S X=$E(X,1,$L(X)-1)
.N M,N S M=32,N=IOM-M
.W $E(X,1,IOM),! S X=$E(X,IOM+1,$L(X))
.F Q:X="" W ?M-3,"...",$E(X,1,N),! S X=$E(X,N+1,$L(X))
Q
PRINT ; protocol ABSP P1 PRINT PATIENT ; print a patient's results
; More aptly, it's "print selected lines"
W !,"Enter the line numbers you wish to print. For example,",!
W "enter 3-7 to print lines 3 through 7.",!
N IEN D SELECPAT(.IEN) ; select a patient(s)
I $D(IEN)<10 G PRINT99 ; none selected
N IO I '$$DEVICE G PRINT99
U $P D:IO=$P FULL^VALM1 U IO
D PRINTHDR
N A S A="" F S A=$O(IEN(A)) Q:A="" D PRINTA(A)
PRINT9 ; joined here from PRINTALL,CLAIMLOG
D BYE^ABSPOSU5 ; this does DO ^%ZISC to close IO for you
PRINT99 ; joined here from PRINTALL,CLAIMLOG
D ANY^ABSPOS2A ;PRESSANY^ABSPOSU5()
PRINT999 S VALMBCK="R" ;$S(VALMCC:"",1:"R")
Q
MAKERXI ; IEN(*)=line numbers we want to convert to prescription numbers
; builds RXI(*)="" or maybe data, ignore whatever you get on right side
S IEN="" F S IEN=$O(IEN(IEN)) Q:IEN="" D MRXI
Q
MRXI S RXI=$P(@DISPLINE@(IEN),U,2)
I RXI S RXI(RXI)="" Q ; a prescription detail line; take just the one
; else it's a patient line - take all of this patient's prescrip's
N PAT S PAT=$P(@DISPLINE@(IEN),U)
M RXI=@DISP@(PAT) ; merge in all of the patient's prescriptions
Q ; with RXI(*) array set up
CLAIMLOG ; protocol ABSP P1 CLAIM LOG
W !,"Enter the line numbers for which you wish to print claim logs.",!
N IEN D SELECPAT(.IEN) ; select prescription(s) or patients
I $D(IEN)<10 G PRINT99
N IO I '$$DEVICE G PRINT99
U $P D:IO=$P FULL^VALM1 U IO
N RXI D MAKERXI ; IEN(*) -> converted to RXI(*)
; now RXI(*) is the array of RXI's we want to print logs for
S RXI="" F S RXI=$O(RXI(RXI)) Q:RXI="" D CLAIMLOG^ABSPOS6M(RXI,IO)
;D BYE^ABSPOSU5
G PRINT9
RECEIPT ; protocol ABSP P1 RECEIPT ; print receipts
W !,"Enter the line numbers for which you wish to print ",$$NAME^ABSPOS6E(3),".",!
N IEN D SELECPAT(.IEN) ; select prescription(s) or patients
I $D(IEN)<10 G PRINT99
N IO I '$$DEVICE G PRINT99
U $P D:IO=$P FULL^VALM1
N RXI D MAKERXI ; IEN(*) -> converted to RXI(*)
D RECEIPTS^ABSPOS6E(.RXI,IO)
D BYE^ABSPOSU5
G PRINT9
REVERSE ; protocol ABSP P1 REVERSE CLAIM ; reverse selected claims
W "Select the line(s) with the paid claim(s) you wish to REVERSE.",!
N IEN D SELECPAT(.IEN) ; select which ones to reverse
N RXI D MAKERXI ; IEN(*) -> converted to RXI(*)
D FULL^VALM1
N REVTOTAL,REVELECT,ERRCOUNT S (REVTOTAL,REVELECT,ERRCOUNT)=0
S RXI="" F S RXI=$O(RXI(RXI)) Q:RXI="" D
. N X S X=$$REVERS59(RXI,0)
. I X D
. . S REVTOTAL=REVTOTAL+1
. . I X>.5 S REVELECT=REVELECT+1
. E D
. . W "Cannot reverse ",RXI,! S ERRCOUNT=ERRCOUNT+1
W REVTOTAL," claim reversal",$S(REVTOTAL'=1:"s",1:"")," in progress.",!
I ERRCOUNT D
. W "Some claim(s) could not be reversed because only paper claims",!
. W "and Payable electronic claims can be reversed.",!
I REVELECT D TASK^ABSPOSQ1 ; task up a packetizer
D ANY^ABSPOS2A ;D PRESSANY^ABSPOSU5()
N NODISPLY S NODISPLY=1 D UPD^ABSPOS6A
S VALMBCK="R"
;S VALMBCK=""
Q
REVERS59(IEN59,WANTQ2) ;EP - called here from ABSPOSRB too
; IEN59 as usual; $G(WANT2Q)=TRUE if you want packetizer started
; Returns 0 if no, no reversal, it's unreversable
; Returns 0.5 if it's a paper claim that was reversed
; Returns IEN of reversal claim if electronic claim submitted for
; reversal.
N OLDSLOT S OLDSLOT=$$GETSLOT^ABSPOSL
D SETSLOT^ABSPOSL(IEN59)
D LOG^ABSPOSL("Reversal - begin")
N RESULT S RESULT=$$CATEG^ABSPOSUC(IEN59)
;IHS/SD/RLT - 8/24/06 - Patch 18 - begin
;I RESULT'="PAPER",RESULT'="E PAYABLE",RESULT'="E DUPLICATE" Q:$Q 0 Q
;IHS/OIT/CASSEVERN/RAN - 02/07/2011 - Patch 41 - Allow "E CAPTURED" to be reversed.
;I RESULT'="PAPER",RESULT'="E PAYABLE",RESULT'="E DUPLICATE",RESULT'="E REVERSAL REJECTED" Q:$Q 0 Q
I RESULT'="PAPER",RESULT'="E PAYABLE",RESULT'="E DUPLICATE",RESULT'="E REVERSAL REJECTED",RESULT'="E CAPTURED" Q:$Q 0 Q
;IHS/SD/RLT - 8/24/06 - Patch 18 - end
I RESULT="PAPER REVERSAL"!(RESULT="E REVERSAL ACCEPTED") Q:$Q 0 Q
; Okay, reversal is permitted
D ; stamp new starting time
. N DIE,DR,DA S DIE=9002313.59,DA=IEN59,DR="15///NOW;7///NOW" D ^DIE
D LOG59A^ABSPOSQB ; and log contents of 9002313.59
D PREVISLY^ABSPOSIZ(IEN59) ; bracket result text with [Previously: ]
I RESULT="PAPER" D Q:$Q 0.5 Q
. D REVERSP(IEN59) ; reverse the paper claim
. D RELSLOT^ABSPOSL,SETSLOT^ABSPOSL(OLDSLOT)
; Here, reversal of electronic claim:
N CLAIMIEN S CLAIMIEN=$P(^ABSPT(IEN59,0),U,4) ; the claim
N POS S POS=$P(^ABSPT(IEN59,0),U,9) ; and position therein
N REV S REV=$$REVERSE^ABSPECA8(CLAIMIEN,POS) ; construct reversal
D ;S $P(^ABSPT(IEN59,4),U)=REV ; mark claim with reversal
. N DIE,DR,DA S DIE=9002313.59,DA=IEN59,DR="401////"_REV D ^DIE
D LOG^ABSPOSL("Reversal claim `"_REV_" "_$P(^ABSPC(REV,0),U))
N ABSBRXI S ABSBRXI=IEN59 D SETSTAT^ABSPOSU(30) ; waiting to packetize
I $G(WANTQ2) D TASK^ABSPOSQ1
D RELSLOT^ABSPOSL,SETSLOT^ABSPOSL(OLDSLOT)
Q:$Q REV Q
REVERSP(IEN59) ; reverse the given paper claim
N ABSBRXI,OLDSLOT,X,MSG S MSG="Reversed paper claim"
S $P(^ABSPT(IEN59,4),U,3)=1
S ABSBRXI=IEN59
D SETRESU^ABSPOSU(1,MSG)
D LOG59^ABSPOSL(MSG,IEN59)
D SETSTAT^ABSPOSU(99)
Q
RESUBMIT ; protocol ABSP P1 RESUBMIT ; resubmit a claim shown on your screen
W "Select the line(s) with the claim(s) you wish to RESUBMIT.",!
N IEN D SELECPAT(.IEN) ; gives IEN(*)
N RXI D MAKERXI ; IEN(*) -> converted to RXI(*)
D FULL^VALM1
;
;OIT/CAS/RCS 081913 Patch 46 If claim is paid ask if ok to resubmit,delete from list if not
N IEN59 S IEN59="" F S IEN59=$O(RXI(IEN59)) Q:IEN59="" D
.N X S X=$$RESULT59^ABSPOSRX(IEN59)
.I X="E PAYABLE" D Q
..W ! S DIR(0)="Y",DIR("A")="`"_IEN59_" has been paid, do you wish to Resubmit",DIR("B")="NO" D ^DIR K DIR
..W ! I 'Y K RXI(IEN59)
;
N REVCOUNT S REVCOUNT=0
N IEN59 S IEN59="" F S IEN59=$O(RXI(IEN59)) Q:IEN59="" D
.N X S X=$$RESULT59^ABSPOSRX(IEN59)
.;IHS/OIT/CASSEVERN/RAN - 02/07/2011 - Patch 41 - Add "E CAPTURED" to types to be reversed.
.;I X="E PAYABLE"!(X="E DUPLICATE")!(X="E REVERSAL REJECTED") D Q
.I X="E PAYABLE"!(X="E DUPLICATE")!(X="E REVERSAL REJECTED")!(X="E CAPTURED") D Q
..;W "`",IEN59," is Payable; you must REVERSE it first.",!
..W "`",IEN59," will be REVERSED first, then Resubmitted.",!
..S $P(^ABSPT(IEN59,1),U,12)=1
..D REVERS59(IEN59,1)
.I X="PAPER" D Q
..W "`",IEN59," will be REVERSED first, then Resubmitted.",!
..S $P(^ABSPT(IEN59,1),U,12)=1
..D REVERS59(IEN59)
.D RESUB1(IEN59)
.;D PREVISLY^ABSPOSIZ(IEN59)
.W "Resubmitted `",IEN59,! H 1
D TASK^ABSPOSIZ ; task up a "gathering claim info" job
D ANY^ABSPOS2A ;D PRESSANY^ABSPOSU5()
N NODISPLY S NODISPLY=1 D UPD^ABSPOS6A
S VALMBCK="R"
Q
RESUB1(IEN59,MIN) ;EP - from ABSPOSU
; resubmit one entry in .59 ; caller responsible for
; starting up D TASK^ABSPOSIZ
; Also called here from ABSPOSU, for reverse-and-resubmit action
;Kill pointers of previous submissions and reversals
N DIE,DR,DA S DIE=9002313.59,DA=IEN59
S DR="" N I F I=3,4,401:1:403,301:1:302,801:1:803 D
. S:DR]"" DR=DR_";" S DR=DR_I_"///@"
. S DR=DR_";15///NOW;7///NOW" ; stamp new starting time, too
;S DR=DR_";6///"_DUZ ;IHS/OIT/CNI/SCR 033010 - update 'Updated By User' for CPR report patch 38
S DR=DR_";6///`"_DUZ ;IHS/OIT/CNI/RAN 091710 - corrected 'Updated By User' input to properly use INTERNAL value patch 40
I '$G(MIN) D ; ABSP*1.0T7*11 this whole block
. F I=10,11,1.05:.01:1.08,1.13,601:1:603,701:1:703 S DR=DR_";"_I_"///@"
. ;IHS/OIT/SCR 11/20/08 delete new 'incentive amount submitted' field also
. ;I '$P($G(^ABSPT(DA,5)),U,6) F I=501:1:505 S DR=DR_";"_I_"///@"
. I '$P($G(^ABSPT(DA,5)),U,6) F I=501,502,503,505,507 S DR=DR_";"_I_"///@"
D ^DIE
D PREVISLY^ABSPOSIZ(IEN59) ; bracket result text with "[Previously: ]"
; Reset status
N ABSBRXI S ABSBRXI=IEN59 D SETSTAT^ABSPOSU(0)
Q
DEVICE() ;EP - device selection for POS
; want to provide a convenient default
N DEFAULT S DEFAULT="HOME"
N DEVICE S DEVICE=$$DEVICE^ABSPOSU8(DEFAULT)
I 'DEVICE Q ""
Q DEVICE
CANCEL ; protocol ABSP P1 CANCEL CLAIM
N LINE
W !,"Select prescription to cancel by line number. Hurry!"
D SELECPAT(.LINE)
I $O(LINE(""))="" W !,"None selected for cancellation",! G CAN99
S LINE="" F S LINE=$O(LINE(LINE)) Q:LINE="" D
.N PAT,RXI S PAT=$P(@DISPLINE@(LINE),U),RXI=$P(@DISPLINE@(LINE),U,2)
.I RXI D CANC5^ABSPOS6L Q
.; else patient was selected; cancel all of this patient's claims
.S RXI="" F S RXI=$O(@DISP@(PAT,RXI)) Q:RXI="" D CANC5^ABSPOS6L
W !,"Cancellation requests made." H 1
CAN99 D ANY^ABSPOS2A ;D PRESSANY^ABSPOSU5()
N NODISPLY DO UPD^ABSPOS6A S VALMBCK="R"
Q
DISMISS ; protocol ABSP P1 DISMISS ; dismiss a patient from my screen
; This is to remove a patient from the display before the usual
; time window has expired. Do it by:
; 1. Set @DISMISS nodes to 15 minutes from now, so as to keep
; the patient and prescription off our screen until then.
; 2. Zero out the time of last update in @DISP so that the
; winnowing thinks the entry is too old to keep around.
; This functionality is provided with the intent to support
; dismissing an entire patient's record after all processing
; has been completed. Unusual usage may not have the results
; you presume it might have.
DIS0 N IEN,TIME,X,%,%I,%H D NOW^%DTC
S TIME=$$TADD^ABSPOSUD(%,^TMP("ABSPOS",$J,"TIME"))
D SELECPAT(.IEN)
S IEN="" F S IEN=$O(IEN(IEN)) Q:IEN="" D
.N PAT,RXI S PAT=@DISPLINE@(IEN),RXI=$P(PAT,U,2),PAT=$P(PAT,U)
.S @DISMISS@(PAT)=TIME
.;I '$D(@DISP@(PAT)) W "DISP=",DISP," and @DISP@(PAT) is undef",! H 2
.I $D(@DISP@(PAT)) S $P(@DISP@(PAT),U,3)=0
.;I W "Now @DISP@(PAT)=",@DISP@(PAT),! H 2
.W PAT," will be dismissed.",! H 1
.I RXI D
..S @DISMISS@(PAT,RXI)=TIME
..I $D(@DISP@(PAT,RXI)) S $P(@DISP@(PAT,RXI),U,3)=0
..;W PAT," ",RXI," will be dismissed.",! H 1
DIS9 ; some other functions branch to here to go back to main screen
N NODISPLY DO UPD^ABSPOS6A S VALMBCK="R"
Q
SELECPAT(RET) ; Select a patient. Returns patient IEN(s) in array
N VALMA,VAMP,VALMI,VALMAT,VALMY
D EN^VALM2(XQORNOD(0),"O") S VALMI=0 ; allow "O"ptionally answer
W !
M RET=VALMY
Q
CLOSECLM ;protocol ABSP P1 CLOSE CLAIM
;IHS/OIT/SCR 021910 patch 37
N ABSPIEN,X,%,%I,%H,ABSPDFN,ABSPCLSD,IEN,ABSPTIME
D NOW^%DTC
S ABSPTIME=%
W !,"Select the line(s) with the claim(s) you wish to CLOSE",!
D SELECPAT(.IEN) ; select prescription(s) or patients - IEN is expected to be defined
N RXI D MAKERXI ; IEN(*) -> converted to RXI(*)
; now RXI(*) is the array of RXI's we want to print logs for
S RXI="" F S RXI=$O(RXI(RXI)) Q:RXI="" S ABSPCLSD=$$CLOSECLM^ABSPOS6N(RXI)
D ANY^ABSPOS2A
;D CLEAN^VALM10
D EN^ABSPOS6A(DUZ,ABSPTIME)
;S VALMBCK="R"
Q
OPENCLM ;Protocol ABSP P1 RE-OPEN CLAIM
;IHS/OIT/SCR 021910 patch 37
N ABSPOPEN
D FULL^VALM1
S ABSPOPEN=$$OPENCLM^ABSPOS6N
D ANY^ABSPOS2A
N NODISPLY S NODISPLY=1 D UPD^ABSPOS6A
S VALMBCK="R"
Q
ABSPOS6D ; IHS/FCS/DRS - user screen subrous ;
+1 ;;1.0;PHARMACY POINT OF SALE;**14,18,37,38,40,41,46**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;IHS/SD/RLT - 8/24/06 - Patch 18
+4 ; Changed code so rejected reversals can be resubmitted.
+5 QUIT
PRINTALL ; protocol ABSP P1 PRINT ALL ; print all patients' results
+1 NEW IO
IF '$$DEVICE
GOTO PRINT99
+2 USE $PRINCIPAL
IF IO=$PRINCIPAL
DO FULL^VALM1
USE IO
+3 DO PRINTHDR
+4 NEW A
SET A=""
FOR
SET A=$ORDER(@VALMAR@(A))
IF 'A
QUIT
DO PRINTA(A)
+5 GOTO PRINT9
PRINTHDR ; print a header
+1 WRITE VALM("TITLE")," "
+2 NEW %,%H,%I,X,Y
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
WRITE Y,!!
+3 NEW A
SET A=""
FOR
SET A=$ORDER(VALMHDR(A))
IF A=""
QUIT
WRITE VALMHDR(A),!
+4 WRITE !
+5 QUIT
PRINTA(A) ; print line A
+1 ; How could you tell whether this is a patient line or a prescription
+2 ; line? And which patient or prescription is represented?
+3 ; Look at @DISPLINE(n)=patname or patname^rxi
+4 ; Look at @VALMIDX@(n,patien), @VALMIDX@(n,patien,rxien)
+5 IF '$DATA(IOM)
NEW IOM
SET IOM=80
+6 NEW X
Begin DoDot:1
+7 IF $DATA(@VALMAR@(A,0))
SET X=@VALMAR@(A,0)
+8 IF '$TEST
SET X="(? Line "_A_" is missing?)"
+9 FOR
IF $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+10 NEW M,N
SET M=32
SET N=IOM-M
+11 WRITE $EXTRACT(X,1,IOM),!
SET X=$EXTRACT(X,IOM+1,$LENGTH(X))
+12 FOR
IF X=""
QUIT
WRITE ?M-3,"...",$EXTRACT(X,1,N),!
SET X=$EXTRACT(X,N+1,$LENGTH(X))
End DoDot:1
+13 QUIT
PRINT ; protocol ABSP P1 PRINT PATIENT ; print a patient's results
+1 ; More aptly, it's "print selected lines"
+2 WRITE !,"Enter the line numbers you wish to print. For example,",!
+3 WRITE "enter 3-7 to print lines 3 through 7.",!
+4 ; select a patient(s)
NEW IEN
DO SELECPAT(.IEN)
+5 ; none selected
IF $DATA(IEN)<10
GOTO PRINT99
+6 NEW IO
IF '$$DEVICE
GOTO PRINT99
+7 USE $PRINCIPAL
IF IO=$PRINCIPAL
DO FULL^VALM1
USE IO
+8 DO PRINTHDR
+9 NEW A
SET A=""
FOR
SET A=$ORDER(IEN(A))
IF A=""
QUIT
DO PRINTA(A)
PRINT9 ; joined here from PRINTALL,CLAIMLOG
+1 ; this does DO ^%ZISC to close IO for you
DO BYE^ABSPOSU5
PRINT99 ; joined here from PRINTALL,CLAIMLOG
+1 ;PRESSANY^ABSPOSU5()
DO ANY^ABSPOS2A
PRINT999 ;$S(VALMCC:"",1:"R")
SET VALMBCK="R"
+1 QUIT
MAKERXI ; IEN(*)=line numbers we want to convert to prescription numbers
+1 ; builds RXI(*)="" or maybe data, ignore whatever you get on right side
+2 SET IEN=""
FOR
SET IEN=$ORDER(IEN(IEN))
IF IEN=""
QUIT
DO MRXI
+3 QUIT
MRXI SET RXI=$PIECE(@DISPLINE@(IEN),U,2)
+1 ; a prescription detail line; take just the one
IF RXI
SET RXI(RXI)=""
QUIT
+2 ; else it's a patient line - take all of this patient's prescrip's
+3 NEW PAT
SET PAT=$PIECE(@DISPLINE@(IEN),U)
+4 ; merge in all of the patient's prescriptions
MERGE RXI=@DISP@(PAT)
+5 ; with RXI(*) array set up
QUIT
CLAIMLOG ; protocol ABSP P1 CLAIM LOG
+1 WRITE !,"Enter the line numbers for which you wish to print claim logs.",!
+2 ; select prescription(s) or patients
NEW IEN
DO SELECPAT(.IEN)
+3 IF $DATA(IEN)<10
GOTO PRINT99
+4 NEW IO
IF '$$DEVICE
GOTO PRINT99
+5 USE $PRINCIPAL
IF IO=$PRINCIPAL
DO FULL^VALM1
USE IO
+6 ; IEN(*) -> converted to RXI(*)
NEW RXI
DO MAKERXI
+7 ; now RXI(*) is the array of RXI's we want to print logs for
+8 SET RXI=""
FOR
SET RXI=$ORDER(RXI(RXI))
IF RXI=""
QUIT
DO CLAIMLOG^ABSPOS6M(RXI,IO)
+9 ;D BYE^ABSPOSU5
+10 GOTO PRINT9
RECEIPT ; protocol ABSP P1 RECEIPT ; print receipts
+1 WRITE !,"Enter the line numbers for which you wish to print ",$$NAME^ABSPOS6E(3),".",!
+2 ; select prescription(s) or patients
NEW IEN
DO SELECPAT(.IEN)
+3 IF $DATA(IEN)<10
GOTO PRINT99
+4 NEW IO
IF '$$DEVICE
GOTO PRINT99
+5 USE $PRINCIPAL
IF IO=$PRINCIPAL
DO FULL^VALM1
+6 ; IEN(*) -> converted to RXI(*)
NEW RXI
DO MAKERXI
+7 DO RECEIPTS^ABSPOS6E(.RXI,IO)
+8 DO BYE^ABSPOSU5
+9 GOTO PRINT9
REVERSE ; protocol ABSP P1 REVERSE CLAIM ; reverse selected claims
+1 WRITE "Select the line(s) with the paid claim(s) you wish to REVERSE.",!
+2 ; select which ones to reverse
NEW IEN
DO SELECPAT(.IEN)
+3 ; IEN(*) -> converted to RXI(*)
NEW RXI
DO MAKERXI
+4 DO FULL^VALM1
+5 NEW REVTOTAL,REVELECT,ERRCOUNT
SET (REVTOTAL,REVELECT,ERRCOUNT)=0
+6 SET RXI=""
FOR
SET RXI=$ORDER(RXI(RXI))
IF RXI=""
QUIT
Begin DoDot:1
+7 NEW X
SET X=$$REVERS59(RXI,0)
+8 IF X
Begin DoDot:2
+9 SET REVTOTAL=REVTOTAL+1
+10 IF X>.5
SET REVELECT=REVELECT+1
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 WRITE "Cannot reverse ",RXI,!
SET ERRCOUNT=ERRCOUNT+1
End DoDot:2
End DoDot:1
+13 WRITE REVTOTAL," claim reversal",$SELECT(REVTOTAL'=1:"s",1:"")," in progress.",!
+14 IF ERRCOUNT
Begin DoDot:1
+15 WRITE "Some claim(s) could not be reversed because only paper claims",!
+16 WRITE "and Payable electronic claims can be reversed.",!
End DoDot:1
+17 ; task up a packetizer
IF REVELECT
DO TASK^ABSPOSQ1
+18 ;D PRESSANY^ABSPOSU5()
DO ANY^ABSPOS2A
+19 NEW NODISPLY
SET NODISPLY=1
DO UPD^ABSPOS6A
+20 SET VALMBCK="R"
+21 ;S VALMBCK=""
+22 QUIT
REVERS59(IEN59,WANTQ2) ;EP - called here from ABSPOSRB too
+1 ; IEN59 as usual; $G(WANT2Q)=TRUE if you want packetizer started
+2 ; Returns 0 if no, no reversal, it's unreversable
+3 ; Returns 0.5 if it's a paper claim that was reversed
+4 ; Returns IEN of reversal claim if electronic claim submitted for
+5 ; reversal.
+6 NEW OLDSLOT
SET OLDSLOT=$$GETSLOT^ABSPOSL
+7 DO SETSLOT^ABSPOSL(IEN59)
+8 DO LOG^ABSPOSL("Reversal - begin")
+9 NEW RESULT
SET RESULT=$$CATEG^ABSPOSUC(IEN59)
+10 ;IHS/SD/RLT - 8/24/06 - Patch 18 - begin
+11 ;I RESULT'="PAPER",RESULT'="E PAYABLE",RESULT'="E DUPLICATE" Q:$Q 0 Q
+12 ;IHS/OIT/CASSEVERN/RAN - 02/07/2011 - Patch 41 - Allow "E CAPTURED" to be reversed.
+13 ;I RESULT'="PAPER",RESULT'="E PAYABLE",RESULT'="E DUPLICATE",RESULT'="E REVERSAL REJECTED" Q:$Q 0 Q
+14 IF RESULT'="PAPER"
IF RESULT'="E PAYABLE"
IF RESULT'="E DUPLICATE"
IF RESULT'="E REVERSAL REJECTED"
IF RESULT'="E CAPTURED"
IF $QUIT
QUIT 0
QUIT
+15 ;IHS/SD/RLT - 8/24/06 - Patch 18 - end
+16 IF RESULT="PAPER REVERSAL"!(RESULT="E REVERSAL ACCEPTED")
IF $QUIT
QUIT 0
QUIT
+17 ; Okay, reversal is permitted
+18 ; stamp new starting time
Begin DoDot:1
+19 NEW DIE,DR,DA
SET DIE=9002313.59
SET DA=IEN59
SET DR="15///NOW;7///NOW"
DO ^DIE
End DoDot:1
+20 ; and log contents of 9002313.59
DO LOG59A^ABSPOSQB
+21 ; bracket result text with [Previously: ]
DO PREVISLY^ABSPOSIZ(IEN59)
+22 IF RESULT="PAPER"
Begin DoDot:1
+23 ; reverse the paper claim
DO REVERSP(IEN59)
+24 DO RELSLOT^ABSPOSL
DO SETSLOT^ABSPOSL(OLDSLOT)
End DoDot:1
IF $QUIT
QUIT 0.5
QUIT
+25 ; Here, reversal of electronic claim:
+26 ; the claim
NEW CLAIMIEN
SET CLAIMIEN=$PIECE(^ABSPT(IEN59,0),U,4)
+27 ; and position therein
NEW POS
SET POS=$PIECE(^ABSPT(IEN59,0),U,9)
+28 ; construct reversal
NEW REV
SET REV=$$REVERSE^ABSPECA8(CLAIMIEN,POS)
+29 ;S $P(^ABSPT(IEN59,4),U)=REV ; mark claim with reversal
Begin DoDot:1
+30 NEW DIE,DR,DA
SET DIE=9002313.59
SET DA=IEN59
SET DR="401////"_REV
DO ^DIE
End DoDot:1
+31 DO LOG^ABSPOSL("Reversal claim `"_REV_" "_$PIECE(^ABSPC(REV,0),U))
+32 ; waiting to packetize
NEW ABSBRXI
SET ABSBRXI=IEN59
DO SETSTAT^ABSPOSU(30)
+33 IF $GET(WANTQ2)
DO TASK^ABSPOSQ1
+34 DO RELSLOT^ABSPOSL
DO SETSLOT^ABSPOSL(OLDSLOT)
+35 IF $QUIT
QUIT REV
QUIT
REVERSP(IEN59) ; reverse the given paper claim
+1 NEW ABSBRXI,OLDSLOT,X,MSG
SET MSG="Reversed paper claim"
+2 SET $PIECE(^ABSPT(IEN59,4),U,3)=1
+3 SET ABSBRXI=IEN59
+4 DO SETRESU^ABSPOSU(1,MSG)
+5 DO LOG59^ABSPOSL(MSG,IEN59)
+6 DO SETSTAT^ABSPOSU(99)
+7 QUIT
RESUBMIT ; protocol ABSP P1 RESUBMIT ; resubmit a claim shown on your screen
+1 WRITE "Select the line(s) with the claim(s) you wish to RESUBMIT.",!
+2 ; gives IEN(*)
NEW IEN
DO SELECPAT(.IEN)
+3 ; IEN(*) -> converted to RXI(*)
NEW RXI
DO MAKERXI
+4 DO FULL^VALM1
+5 ;
+6 ;OIT/CAS/RCS 081913 Patch 46 If claim is paid ask if ok to resubmit,delete from list if not
+7 NEW IEN59
SET IEN59=""
FOR
SET IEN59=$ORDER(RXI(IEN59))
IF IEN59=""
QUIT
Begin DoDot:1
+8 NEW X
SET X=$$RESULT59^ABSPOSRX(IEN59)
+9 IF X="E PAYABLE"
Begin DoDot:2
+10 WRITE !
SET DIR(0)="Y"
SET DIR("A")="`"_IEN59_" has been paid, do you wish to Resubmit"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+11 WRITE !
IF 'Y
KILL RXI(IEN59)
End DoDot:2
QUIT
End DoDot:1
+12 ;
+13 NEW REVCOUNT
SET REVCOUNT=0
+14 NEW IEN59
SET IEN59=""
FOR
SET IEN59=$ORDER(RXI(IEN59))
IF IEN59=""
QUIT
Begin DoDot:1
+15 NEW X
SET X=$$RESULT59^ABSPOSRX(IEN59)
+16 ;IHS/OIT/CASSEVERN/RAN - 02/07/2011 - Patch 41 - Add "E CAPTURED" to types to be reversed.
+17 ;I X="E PAYABLE"!(X="E DUPLICATE")!(X="E REVERSAL REJECTED") D Q
+18 IF X="E PAYABLE"!(X="E DUPLICATE")!(X="E REVERSAL REJECTED")!(X="E CAPTURED")
Begin DoDot:2
+19 ;W "`",IEN59," is Payable; you must REVERSE it first.",!
+20 WRITE "`",IEN59," will be REVERSED first, then Resubmitted.",!
+21 SET $PIECE(^ABSPT(IEN59,1),U,12)=1
+22 DO REVERS59(IEN59,1)
End DoDot:2
QUIT
+23 IF X="PAPER"
Begin DoDot:2
+24 WRITE "`",IEN59," will be REVERSED first, then Resubmitted.",!
+25 SET $PIECE(^ABSPT(IEN59,1),U,12)=1
+26 DO REVERS59(IEN59)
End DoDot:2
QUIT
+27 DO RESUB1(IEN59)
+28 ;D PREVISLY^ABSPOSIZ(IEN59)
+29 WRITE "Resubmitted `",IEN59,!
HANG 1
End DoDot:1
+30 ; task up a "gathering claim info" job
DO TASK^ABSPOSIZ
+31 ;D PRESSANY^ABSPOSU5()
DO ANY^ABSPOS2A
+32 NEW NODISPLY
SET NODISPLY=1
DO UPD^ABSPOS6A
+33 SET VALMBCK="R"
+34 QUIT
RESUB1(IEN59,MIN) ;EP - from ABSPOSU
+1 ; resubmit one entry in .59 ; caller responsible for
+2 ; starting up D TASK^ABSPOSIZ
+3 ; Also called here from ABSPOSU, for reverse-and-resubmit action
+4 ;Kill pointers of previous submissions and reversals
+5 NEW DIE,DR,DA
SET DIE=9002313.59
SET DA=IEN59
+6 SET DR=""
NEW I
FOR I=3,4,401:1:403,301:1:302,801:1:803
Begin DoDot:1
+7 IF DR]""
SET DR=DR_";"
SET DR=DR_I_"///@"
+8 ; stamp new starting time, too
SET DR=DR_";15///NOW;7///NOW"
End DoDot:1
+9 ;S DR=DR_";6///"_DUZ ;IHS/OIT/CNI/SCR 033010 - update 'Updated By User' for CPR report patch 38
+10 ;IHS/OIT/CNI/RAN 091710 - corrected 'Updated By User' input to properly use INTERNAL value patch 40
SET DR=DR_";6///`"_DUZ
+11 ; ABSP*1.0T7*11 this whole block
IF '$GET(MIN)
Begin DoDot:1
+12 FOR I=10,11,1.05:.01:1.08,1.13,601:1:603,701:1:703
SET DR=DR_";"_I_"///@"
+13 ;IHS/OIT/SCR 11/20/08 delete new 'incentive amount submitted' field also
+14 ;I '$P($G(^ABSPT(DA,5)),U,6) F I=501:1:505 S DR=DR_";"_I_"///@"
+15 IF '$PIECE($GET(^ABSPT(DA,5)),U,6)
FOR I=501,502,503,505,507
SET DR=DR_";"_I_"///@"
End DoDot:1
+16 DO ^DIE
+17 ; bracket result text with "[Previously: ]"
DO PREVISLY^ABSPOSIZ(IEN59)
+18 ; Reset status
+19 NEW ABSBRXI
SET ABSBRXI=IEN59
DO SETSTAT^ABSPOSU(0)
+20 QUIT
DEVICE() ;EP - device selection for POS
+1 ; want to provide a convenient default
+2 NEW DEFAULT
SET DEFAULT="HOME"
+3 NEW DEVICE
SET DEVICE=$$DEVICE^ABSPOSU8(DEFAULT)
+4 IF 'DEVICE
QUIT ""
+5 QUIT DEVICE
CANCEL ; protocol ABSP P1 CANCEL CLAIM
+1 NEW LINE
+2 WRITE !,"Select prescription to cancel by line number. Hurry!"
+3 DO SELECPAT(.LINE)
+4 IF $ORDER(LINE(""))=""
WRITE !,"None selected for cancellation",!
GOTO CAN99
+5 SET LINE=""
FOR
SET LINE=$ORDER(LINE(LINE))
IF LINE=""
QUIT
Begin DoDot:1
+6 NEW PAT,RXI
SET PAT=$PIECE(@DISPLINE@(LINE),U)
SET RXI=$PIECE(@DISPLINE@(LINE),U,2)
+7 IF RXI
DO CANC5^ABSPOS6L
QUIT
+8 ; else patient was selected; cancel all of this patient's claims
+9 SET RXI=""
FOR
SET RXI=$ORDER(@DISP@(PAT,RXI))
IF RXI=""
QUIT
DO CANC5^ABSPOS6L
End DoDot:1
+10 WRITE !,"Cancellation requests made."
HANG 1
CAN99 ;D PRESSANY^ABSPOSU5()
DO ANY^ABSPOS2A
+1 NEW NODISPLY
DO UPD^ABSPOS6A
SET VALMBCK="R"
+2 QUIT
DISMISS ; protocol ABSP P1 DISMISS ; dismiss a patient from my screen
+1 ; This is to remove a patient from the display before the usual
+2 ; time window has expired. Do it by:
+3 ; 1. Set @DISMISS nodes to 15 minutes from now, so as to keep
+4 ; the patient and prescription off our screen until then.
+5 ; 2. Zero out the time of last update in @DISP so that the
+6 ; winnowing thinks the entry is too old to keep around.
+7 ; This functionality is provided with the intent to support
+8 ; dismissing an entire patient's record after all processing
+9 ; has been completed. Unusual usage may not have the results
+10 ; you presume it might have.
DIS0 NEW IEN,TIME,X,%,%I,%H
DO NOW^%DTC
+1 SET TIME=$$TADD^ABSPOSUD(%,^TMP("ABSPOS",$JOB,"TIME"))
+2 DO SELECPAT(.IEN)
+3 SET IEN=""
FOR
SET IEN=$ORDER(IEN(IEN))
IF IEN=""
QUIT
Begin DoDot:1
+4 NEW PAT,RXI
SET PAT=@DISPLINE@(IEN)
SET RXI=$PIECE(PAT,U,2)
SET PAT=$PIECE(PAT,U)
+5 SET @DISMISS@(PAT)=TIME
+6 ;I '$D(@DISP@(PAT)) W "DISP=",DISP," and @DISP@(PAT) is undef",! H 2
+7 IF $DATA(@DISP@(PAT))
SET $PIECE(@DISP@(PAT),U,3)=0
+8 ;I W "Now @DISP@(PAT)=",@DISP@(PAT),! H 2
+9 WRITE PAT," will be dismissed.",!
HANG 1
+10 IF RXI
Begin DoDot:2
+11 SET @DISMISS@(PAT,RXI)=TIME
+12 IF $DATA(@DISP@(PAT,RXI))
SET $PIECE(@DISP@(PAT,RXI),U,3)=0
+13 ;W PAT," ",RXI," will be dismissed.",! H 1
End DoDot:2
End DoDot:1
DIS9 ; some other functions branch to here to go back to main screen
+1 NEW NODISPLY
DO UPD^ABSPOS6A
SET VALMBCK="R"
+2 QUIT
SELECPAT(RET) ; Select a patient. Returns patient IEN(s) in array
+1 NEW VALMA,VAMP,VALMI,VALMAT,VALMY
+2 ; allow "O"ptionally answer
DO EN^VALM2(XQORNOD(0),"O")
SET VALMI=0
+3 WRITE !
+4 MERGE RET=VALMY
+5 QUIT
CLOSECLM ;protocol ABSP P1 CLOSE CLAIM
+1 ;IHS/OIT/SCR 021910 patch 37
+2 NEW ABSPIEN,X,%,%I,%H,ABSPDFN,ABSPCLSD,IEN,ABSPTIME
+3 DO NOW^%DTC
+4 SET ABSPTIME=%
+5 WRITE !,"Select the line(s) with the claim(s) you wish to CLOSE",!
+6 ; select prescription(s) or patients - IEN is expected to be defined
DO SELECPAT(.IEN)
+7 ; IEN(*) -> converted to RXI(*)
NEW RXI
DO MAKERXI
+8 ; now RXI(*) is the array of RXI's we want to print logs for
+9 SET RXI=""
FOR
SET RXI=$ORDER(RXI(RXI))
IF RXI=""
QUIT
SET ABSPCLSD=$$CLOSECLM^ABSPOS6N(RXI)
+10 DO ANY^ABSPOS2A
+11 ;D CLEAN^VALM10
+12 DO EN^ABSPOS6A(DUZ,ABSPTIME)
+13 ;S VALMBCK="R"
+14 QUIT
OPENCLM ;Protocol ABSP P1 RE-OPEN CLAIM
+1 ;IHS/OIT/SCR 021910 patch 37
+2 NEW ABSPOPEN
+3 DO FULL^VALM1
+4 SET ABSPOPEN=$$OPENCLM^ABSPOS6N
+5 DO ANY^ABSPOS2A
+6 NEW NODISPLY
SET NODISPLY=1
DO UPD^ABSPOS6A
+7 SET VALMBCK="R"
+8 QUIT
