ABSPOS6N ; IHS/OIT/SCR - Functions to Close and Re-open a claim ;
;;1.0;PHARMACY POINT OF SALE;**37,40**;JUN 21, 2001;Build 38
Q
CLOSECLM(ABSP59) ;EP - from ABSPOS6D
;
; parameters: ABSP59 ien to Transaction Log where claim information is located
;
;IHS/OIT/CASSEVERN/RAN - 12/16/2010 - Patch 40 Following line added to Allow us to use full screen not
U $P D:IO=$P FULL^VALM1 U IO
W "You have selected to close the following claim",!
N ABSPRFL,ABSPNAM,ABSPDFN,ABSPRSLT,DIR,Y,ABSPANS,ABSPCLSD
S ABSPANS=0
S ABSPCLSD=0
W "Prescription #",$P(^ABSPT(ABSP59,1),U,11) ;
S ABSPRFL=$P($G(^ABSPT(ABSP59,1)),U) I ABSPRFL W " Refill #",ABSPRFL
W " (ABSP59=",ABSP59,")"
W !
W "Patient: "
;S X=$P(REC(0),U,6) I X]"" S X=$P($G(^DPT(X,0)),U) W X
S ABSPDFN=$P($G(^ABSPT(ABSP59,0)),U,6)
I ABSPDFN>0 S ABSPNAM=$P($G(^DPT(ABSPDFN,0)),U) W ABSPNAM
;
;NOW...find out if this claim was rejected - if not, it can't be closed
S ABSPRSLT=$$CATEG^ABSPOSUC(ABSP59,1)
W !,"This claim has a status of : ",ABSPRSLT
I ABSPRSLT="E REJECTED" D
.W !,"This claim can be closed"
.S ABSPANS=1
.S DIR("B")="YES"
.Q
I ABSPRSLT'="E REJECTED" D
.W !,"This claim can not be closed"
.S ABSPANS=0
.S DIR("B")="NO"
.Q
S DIR("A")="CONTINUE CLOSING CLAIM"
S DIR(0)="Y"
D ^DIR
Q:($G(DTOUT)!$G(DUOUT))
S:ABSPANS ABSPANS=Y
I ABSPANS D
.;I 1 D
.;IHS/OIT/CASSEVERN/RAN - 12/7/2010 - Patch 40 Added Product Not Covered as valid Reason for closure
.S DIR(0)="SX^C:Claim Too Old;R:Refill Too Soon;P:Plan Limit Exceeded;X:Product Not Covered"
.S DIR("B")="X"
.S DIR("A")="CLOSE REASON"
.D ^DIR
.Q:($G(DTOUT)!$G(DUOUT))
.W !,"ABOUT TO CLOSE THIS CLAIM WITH REASON "_Y
.S ABSPCLSD=$$UPDTCLS(ABSP59,Y)
.Q
I ABSPCLSD D
.N ABSP57 S ABSP57=$$NEW57^ABSPOSU(ABSP59) ;create an entry in transaction log recording this change
.W !,"THE CLAIM WAS CLOSED"
.;S ^TMP("ABSPOS",$J,"PATIENT")=ABSPDFN
W:'ABSPCLSD !,"THE CLAIM WAS *NOT* CLOSED"
Q ABSPCLSD
;
UPDTCLS(ABSP59,ABSPRSN) ;UPDATE ^ABSPT WITH CLOSED STATUS, USER INFO, DATE AND REASON
N ABSPNOW,ABPDUZ,ABSPCLM,ABSPDUZ,ABSPRET,ABSPLOCK,DIE,DR,DA,%,Y,DIC,ABSPDFN
D NOW^%DTC
S ABSPRET=0
S ABSPNOW=%
S ABSPDUZ=DUZ
S ABSPDFN=$P($G(^ABSPT(ABSP59,0)),U,6)
S ABSPCLM=$P($G(^ABSPT(ABSP59,0)),U,4)
W !,"Updating Claim '"_ABSPCLM
;Q:'ABSPCLM ABSPRET
;L +^ABSPC(ABSPCLM):0
L +^ABSPT(ABSP59):3
S ABSPLOCK=$T
I ABSPLOCK D
.S DIE="^ABSPT("
.S DA=ABSP59
.;S DR="901///1;902////"_ABSPNOW_";903////"_ABSPDUZ_";906///"_ABSPRSN
.S DR="7////"_ABSPNOW_";901///1;902////"_ABSPNOW_";903////"_ABSPDUZ_";906///"_ABSPRSN
.D ^DIE
.L -^ABSPT(ABSP59)
.S ABSPRET=1
.Q
I 'ABSPLOCK W !,"ANOTHER USER IS EDITING THIS ENTRY. TRY AGAIN LATER"
;S ^TMP("ABSPOS",$J,"PATIENT")=ABSPDFN
Q ABSPRET
;
OPENCLM() ;re-open claim display driver
N ABSP59,ABSPRSLT,ABSPDONE,Y,ABSPTXN,ABSPDFN,DIR
S ABSPRSLT=0
W !,!
S ABSPDONE=0
F Q:ABSPDONE D
.S ABSPDFN=$$CLSDPAT()
.I ABSPDFN<1 S ABSPDONE=1 Q
.I ABSPDFN=0 Q
.S ABSPTXN=$$CLSDTXN(ABSPDFN)
.I 'ABSPTXN S ABSPDONE=1 Q
.S ABSPRSLT=$$UPDTOPN(ABSPTXN)
.S DIR(0)="Y"
.S DIR("B")="NO"
.S DIR("A")="RE-OPEN more claims"
.D ^DIR
.I $G(DTOUT)!$G(DUOUT)!'$G(Y) S ABSPDONE=1 Q
.W:ABSPRSLT !,"Done.",!
H 1
Q ABSPRSLT
;
UPDTOPN(ABSP59) ;UPDATE ^ABSPT WITH OPEN STATUS, USER INFO, DATE
N ABSPNOW,ABPDUZ,ABSPCLM,ABSPRET,ABSPLOCK,DIE,DR,DA,%,Y,DIC
N DIR
S DIR("A")="RE-OPEN THIS CLAIM"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR
Q:'+Y
D NOW^%DTC
S ABSPRET=0
S ABSPNOW=%
S ABSPDUZ=DUZ
W !," ***Re-opening Claim*** "_ABSP59
L +^ABSPT(ABSP59):3
S ABSPLOCK=$T
I ABSPLOCK D
.S DIE="^ABSPT("
.S DA=ABSP59
.S DR="7////"_ABSPNOW_";901////0;904////"_ABSPNOW_";905////"_ABSPDUZ
.D ^DIE
.L -^ABSPT(ABSP59)
.N ABSP57 S ABSP57=$$NEW57^ABSPOSU(ABSP59) ;create an entry in transaction log recording this change
.S ABSPRET=1
.Q
I 'ABSPLOCK W !,"ANOTHER USER IS EDITING THIS ENTRY. TRY AGAIN LATER"
Q ABSPRET
CLSDPAT() ;display patients that have POS transaction
N DIC,ABSPDUZ2
S ABSPDUZ2=DUZ(2)
S DUZ(2)=0 ;TO ALLOW USERS TO SELECT FROM ALL LOCATIONS
S DIC=2,DIC(0)="AEMQZ",DIC("A")="Select Closed Claims for which patient? "
S DIC("S")="I $D(^ABSPT(""AC"",Y))"
D ^DIC W !
S DUZ(2)=ABSPDUZ2 ; Restore original DUZ(2) ; ABSP*1.0T7*7
S ABSPDFN=+Y
Q ABSPDFN
;
CLSDTXN(ABSPDFN) ;display closed transactions for identified patient
N ABSPTXN,DIR,ABSPRTRN,ABSPARRY,ABSPQUIT,ABSPCNT
S ABSPCNT=0
S ABSPQUIT=0
S ABSPRTRN=0
S ABSPTXN=""
S DIR(0)="SO^"
F S ABSPTXN=$O(^ABSPT("AC",ABSPDFN,ABSPTXN)) Q:ABSPTXN="" D
.I $P($G(^ABSPT(ABSPTXN,9)),U,1)=1 D
..S ABSPCNT=ABSPCNT+1
..S DIR(0)=DIR(0)_ABSPCNT_":"_ABSPTXN_";"
..S ABSPARRY(ABSPCNT)=ABSPTXN
..S ABSPUSR=$P($G(^ABSPT(ABSPTXN,9)),U,3)
..S ABSPRSN=$P($G(^ABSPT(ABSPTXN,9)),U,6)
..;IHS/OIT/CASSEVERN/RAN - 12/16/2010 - Patch 40 Added Product Not Covered as valid Reason for closure
..S ABSPRSN=$S(ABSPRSN="C":"Claim Too Old",ABSPRSN="R":"Refill Too Soon",ABSPRSN="P":"Plan Limit Exceeded",ABSPRSN="X":"Product Not Covered",1:"NO CLOSE REASON")
..W !!,ABSPTXN,!," Closed on "
..S Y=$P($G(^ABSPT(ABSPTXN,9)),U,2)
..D DT^DIO2 ;this writes out a well formatted date...believe it or not...
..W !," By: "_$P($G(^VA(200,ABSPUSR,0)),U,1)_" Close Reason: "_ABSPRSN
.Q
I DIR("0")="SO^" D
.S DIR("B")="NO"
.S DIR("A")="Would you like to look for another patient"
.S DIR("A",1)="No CLOSED transactions found for this patient"
.S DIR("0")="Y"
.D ^DIR
.I +Y S ABSPRTRN=0
.S ABSPQUIT=1
Q:ABSPQUIT ABSPRTRN
I DIR("0")'="SO^" D
.S DIR("B")="1"
.S DIR("A")="Select CLOSED transaction to RE-OPEN"
.D ^DIR
.Q:$G(DTOUT)!$G(DUOUT)
.S:$G(Y) ABSPRTRN=ABSPARRY(+Y)
Q ABSPRTRN
ABSPOS6N ; IHS/OIT/SCR - Functions to Close and Re-open a claim ;
+1 ;;1.0;PHARMACY POINT OF SALE;**37,40**;JUN 21, 2001;Build 38
+2 QUIT
CLOSECLM(ABSP59) ;EP - from ABSPOS6D
+1 ;
+2 ; parameters: ABSP59 ien to Transaction Log where claim information is located
+3 ;
+4 ;IHS/OIT/CASSEVERN/RAN - 12/16/2010 - Patch 40 Following line added to Allow us to use full screen not
+5 USE $PRINCIPAL
IF IO=$PRINCIPAL
DO FULL^VALM1
USE IO
+6 WRITE "You have selected to close the following claim",!
+7 NEW ABSPRFL,ABSPNAM,ABSPDFN,ABSPRSLT,DIR,Y,ABSPANS,ABSPCLSD
+8 SET ABSPANS=0
+9 SET ABSPCLSD=0
+10 ;
WRITE "Prescription #",$PIECE(^ABSPT(ABSP59,1),U,11)
+11 SET ABSPRFL=$PIECE($GET(^ABSPT(ABSP59,1)),U)
IF ABSPRFL
WRITE " Refill #",ABSPRFL
+12 WRITE " (ABSP59=",ABSP59,")"
+13 WRITE !
+14 WRITE "Patient: "
+15 ;S X=$P(REC(0),U,6) I X]"" S X=$P($G(^DPT(X,0)),U) W X
+16 SET ABSPDFN=$PIECE($GET(^ABSPT(ABSP59,0)),U,6)
+17 IF ABSPDFN>0
SET ABSPNAM=$PIECE($GET(^DPT(ABSPDFN,0)),U)
WRITE ABSPNAM
+18 ;
+19 ;NOW...find out if this claim was rejected - if not, it can't be closed
+20 SET ABSPRSLT=$$CATEG^ABSPOSUC(ABSP59,1)
+21 WRITE !,"This claim has a status of : ",ABSPRSLT
+22 IF ABSPRSLT="E REJECTED"
Begin DoDot:1
+23 WRITE !,"This claim can be closed"
+24 SET ABSPANS=1
+25 SET DIR("B")="YES"
+26 QUIT
End DoDot:1
+27 IF ABSPRSLT'="E REJECTED"
Begin DoDot:1
+28 WRITE !,"This claim can not be closed"
+29 SET ABSPANS=0
+30 SET DIR("B")="NO"
+31 QUIT
End DoDot:1
+32 SET DIR("A")="CONTINUE CLOSING CLAIM"
+33 SET DIR(0)="Y"
+34 DO ^DIR
+35 IF ($GET(DTOUT)!$GET(DUOUT))
QUIT
+36 IF ABSPANS
SET ABSPANS=Y
+37 IF ABSPANS
Begin DoDot:1
+38 ;I 1 D
+39 ;IHS/OIT/CASSEVERN/RAN - 12/7/2010 - Patch 40 Added Product Not Covered as valid Reason for closure
+40 SET DIR(0)="SX^C:Claim Too Old;R:Refill Too Soon;P:Plan Limit Exceeded;X:Product Not Covered"
+41 SET DIR("B")="X"
+42 SET DIR("A")="CLOSE REASON"
+43 DO ^DIR
+44 IF ($GET(DTOUT)!$GET(DUOUT))
QUIT
+45 WRITE !,"ABOUT TO CLOSE THIS CLAIM WITH REASON "_Y
+46 SET ABSPCLSD=$$UPDTCLS(ABSP59,Y)
+47 QUIT
End DoDot:1
+48 IF ABSPCLSD
Begin DoDot:1
+49 ;create an entry in transaction log recording this change
NEW ABSP57
SET ABSP57=$$NEW57^ABSPOSU(ABSP59)
+50 WRITE !,"THE CLAIM WAS CLOSED"
+51 ;S ^TMP("ABSPOS",$J,"PATIENT")=ABSPDFN
End DoDot:1
+52 IF 'ABSPCLSD
WRITE !,"THE CLAIM WAS *NOT* CLOSED"
+53 QUIT ABSPCLSD
+54 ;
UPDTCLS(ABSP59,ABSPRSN) ;UPDATE ^ABSPT WITH CLOSED STATUS, USER INFO, DATE AND REASON
+1 NEW ABSPNOW,ABPDUZ,ABSPCLM,ABSPDUZ,ABSPRET,ABSPLOCK,DIE,DR,DA,%,Y,DIC,ABSPDFN
+2 DO NOW^%DTC
+3 SET ABSPRET=0
+4 SET ABSPNOW=%
+5 SET ABSPDUZ=DUZ
+6 SET ABSPDFN=$PIECE($GET(^ABSPT(ABSP59,0)),U,6)
+7 SET ABSPCLM=$PIECE($GET(^ABSPT(ABSP59,0)),U,4)
+8 WRITE !,"Updating Claim '"_ABSPCLM
+9 ;Q:'ABSPCLM ABSPRET
+10 ;L +^ABSPC(ABSPCLM):0
+11 LOCK +^ABSPT(ABSP59):3
+12 SET ABSPLOCK=$TEST
+13 IF ABSPLOCK
Begin DoDot:1
+14 SET DIE="^ABSPT("
+15 SET DA=ABSP59
+16 ;S DR="901///1;902////"_ABSPNOW_";903////"_ABSPDUZ_";906///"_ABSPRSN
+17 SET DR="7////"_ABSPNOW_";901///1;902////"_ABSPNOW_";903////"_ABSPDUZ_";906///"_ABSPRSN
+18 DO ^DIE
+19 LOCK -^ABSPT(ABSP59)
+20 SET ABSPRET=1
+21 QUIT
End DoDot:1
+22 IF 'ABSPLOCK
WRITE !,"ANOTHER USER IS EDITING THIS ENTRY. TRY AGAIN LATER"
+23 ;S ^TMP("ABSPOS",$J,"PATIENT")=ABSPDFN
+24 QUIT ABSPRET
+25 ;
OPENCLM() ;re-open claim display driver
+1 NEW ABSP59,ABSPRSLT,ABSPDONE,Y,ABSPTXN,ABSPDFN,DIR
+2 SET ABSPRSLT=0
+3 WRITE !,!
+4 SET ABSPDONE=0
+5 FOR
IF ABSPDONE
QUIT
Begin DoDot:1
+6 SET ABSPDFN=$$CLSDPAT()
+7 IF ABSPDFN<1
SET ABSPDONE=1
QUIT
+8 IF ABSPDFN=0
QUIT
+9 SET ABSPTXN=$$CLSDTXN(ABSPDFN)
+10 IF 'ABSPTXN
SET ABSPDONE=1
QUIT
+11 SET ABSPRSLT=$$UPDTOPN(ABSPTXN)
+12 SET DIR(0)="Y"
+13 SET DIR("B")="NO"
+14 SET DIR("A")="RE-OPEN more claims"
+15 DO ^DIR
+16 IF $GET(DTOUT)!$GET(DUOUT)!'$GET(Y)
SET ABSPDONE=1
QUIT
+17 IF ABSPRSLT
WRITE !,"Done.",!
End DoDot:1
+18 HANG 1
+19 QUIT ABSPRSLT
+20 ;
UPDTOPN(ABSP59) ;UPDATE ^ABSPT WITH OPEN STATUS, USER INFO, DATE
+1 NEW ABSPNOW,ABPDUZ,ABSPCLM,ABSPRET,ABSPLOCK,DIE,DR,DA,%,Y,DIC
+2 NEW DIR
+3 SET DIR("A")="RE-OPEN THIS CLAIM"
+4 SET DIR(0)="Y"
SET DIR("B")="YES"
+5 DO ^DIR
+6 IF '+Y
QUIT
+7 DO NOW^%DTC
+8 SET ABSPRET=0
+9 SET ABSPNOW=%
+10 SET ABSPDUZ=DUZ
+11 WRITE !," ***Re-opening Claim*** "_ABSP59
+12 LOCK +^ABSPT(ABSP59):3
+13 SET ABSPLOCK=$TEST
+14 IF ABSPLOCK
Begin DoDot:1
+15 SET DIE="^ABSPT("
+16 SET DA=ABSP59
+17 SET DR="7////"_ABSPNOW_";901////0;904////"_ABSPNOW_";905////"_ABSPDUZ
+18 DO ^DIE
+19 LOCK -^ABSPT(ABSP59)
+20 ;create an entry in transaction log recording this change
NEW ABSP57
SET ABSP57=$$NEW57^ABSPOSU(ABSP59)
+21 SET ABSPRET=1
+22 QUIT
End DoDot:1
+23 IF 'ABSPLOCK
WRITE !,"ANOTHER USER IS EDITING THIS ENTRY. TRY AGAIN LATER"
+24 QUIT ABSPRET
CLSDPAT() ;display patients that have POS transaction
+1 NEW DIC,ABSPDUZ2
+2 SET ABSPDUZ2=DUZ(2)
+3 ;TO ALLOW USERS TO SELECT FROM ALL LOCATIONS
SET DUZ(2)=0
+4 SET DIC=2
SET DIC(0)="AEMQZ"
SET DIC("A")="Select Closed Claims for which patient? "
+5 SET DIC("S")="I $D(^ABSPT(""AC"",Y))"
+6 DO ^DIC
WRITE !
+7 ; Restore original DUZ(2) ; ABSP*1.0T7*7
SET DUZ(2)=ABSPDUZ2
+8 SET ABSPDFN=+Y
+9 QUIT ABSPDFN
+10 ;
CLSDTXN(ABSPDFN) ;display closed transactions for identified patient
+1 NEW ABSPTXN,DIR,ABSPRTRN,ABSPARRY,ABSPQUIT,ABSPCNT
+2 SET ABSPCNT=0
+3 SET ABSPQUIT=0
+4 SET ABSPRTRN=0
+5 SET ABSPTXN=""
+6 SET DIR(0)="SO^"
+7 FOR
SET ABSPTXN=$ORDER(^ABSPT("AC",ABSPDFN,ABSPTXN))
IF ABSPTXN=""
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^ABSPT(ABSPTXN,9)),U,1)=1
Begin DoDot:2
+9 SET ABSPCNT=ABSPCNT+1
+10 SET DIR(0)=DIR(0)_ABSPCNT_":"_ABSPTXN_";"
+11 SET ABSPARRY(ABSPCNT)=ABSPTXN
+12 SET ABSPUSR=$PIECE($GET(^ABSPT(ABSPTXN,9)),U,3)
+13 SET ABSPRSN=$PIECE($GET(^ABSPT(ABSPTXN,9)),U,6)
+14 ;IHS/OIT/CASSEVERN/RAN - 12/16/2010 - Patch 40 Added Product Not Covered as valid Reason for closure
+15 SET ABSPRSN=$SELECT(ABSPRSN="C":"Claim Too Old",ABSPRSN="R":"Refill Too Soon",ABSPRSN="P":"Plan Limit Exceeded",ABSPRSN="X":"Product Not Covered",1:"NO CLOSE REASON")
+16 WRITE !!,ABSPTXN,!," Closed on "
+17 SET Y=$PIECE($GET(^ABSPT(ABSPTXN,9)),U,2)
+18 ;this writes out a well formatted date...believe it or not...
DO DT^DIO2
+19 WRITE !," By: "_$PIECE($GET(^VA(200,ABSPUSR,0)),U,1)_" Close Reason: "_ABSPRSN
End DoDot:2
+20 QUIT
End DoDot:1
+21 IF DIR("0")="SO^"
Begin DoDot:1
+22 SET DIR("B")="NO"
+23 SET DIR("A")="Would you like to look for another patient"
+24 SET DIR("A",1)="No CLOSED transactions found for this patient"
+25 SET DIR("0")="Y"
+26 DO ^DIR
+27 IF +Y
SET ABSPRTRN=0
+28 SET ABSPQUIT=1
End DoDot:1
+29 IF ABSPQUIT
QUIT ABSPRTRN
+30 IF DIR("0")'="SO^"
Begin DoDot:1
+31 SET DIR("B")="1"
+32 SET DIR("A")="Select CLOSED transaction to RE-OPEN"
+33 DO ^DIR
+34 IF $GET(DTOUT)!$GET(DUOUT)
QUIT
+35 IF $GET(Y)
SET ABSPRTRN=ABSPARRY(+Y)
End DoDot:1
+36 QUIT ABSPRTRN
