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

ABSPOS6N.m

Go to the documentation of this file. 
  1. 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
  1.  Q
  1. CLOSECLM(ABSP59)         ;EP - from ABSPOS6D
  1.  ;
  1.  ;  parameters: ABSP59 ien to Transaction Log where claim information is located
  1.  ;
  1.  ;IHS/OIT/CASSEVERN/RAN - 12/16/2010 - Patch 40 Following line added to Allow us to use full screen not 
  1.  U $P D:IO=$P FULL^VALM1 U IO
  1.  W "You have selected to close the following claim",!
  1.  N ABSPRFL,ABSPNAM,ABSPDFN,ABSPRSLT,DIR,Y,ABSPANS,ABSPCLSD
  1.  S ABSPANS=0
  1.  S ABSPCLSD=0
  1.  W "Prescription #",$P(^ABSPT(ABSP59,1),U,11) ;
  1.  S ABSPRFL=$P($G(^ABSPT(ABSP59,1)),U) I ABSPRFL W " Refill #",ABSPRFL
  1.  W "   (ABSP59=",ABSP59,")"
  1.  W !
  1.  W "Patient: "
  1.  ;S X=$P(REC(0),U,6) I X]"" S X=$P($G(^DPT(X,0)),U) W X
  1.  S ABSPDFN=$P($G(^ABSPT(ABSP59,0)),U,6)
  1.  I ABSPDFN>0 S ABSPNAM=$P($G(^DPT(ABSPDFN,0)),U) W ABSPNAM
  1.  ;
  1.  ;NOW...find out if this claim was rejected - if not, it can't be closed
  1.  S ABSPRSLT=$$CATEG^ABSPOSUC(ABSP59,1)
  1.  W !,"This claim has a status of : ",ABSPRSLT
  1.  I ABSPRSLT="E REJECTED" D
  1.  .W !,"This claim can be closed"
  1.  .S ABSPANS=1
  1.  .S DIR("B")="YES"
  1.  .Q
  1.  I ABSPRSLT'="E REJECTED" D
  1.  .W !,"This claim can not be closed"
  1.  .S ABSPANS=0
  1.  .S DIR("B")="NO"
  1.  .Q
  1.  S DIR("A")="CONTINUE CLOSING CLAIM"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  Q:($G(DTOUT)!$G(DUOUT))
  1.  S:ABSPANS ABSPANS=Y
  1.  I ABSPANS D
  1.  .;I 1 D
  1.  .;IHS/OIT/CASSEVERN/RAN - 12/7/2010 - Patch 40 Added Product Not Covered as valid Reason for closure
  1.  .S DIR(0)="SX^C:Claim Too Old;R:Refill Too Soon;P:Plan Limit Exceeded;X:Product Not Covered"
  1.  .S DIR("B")="X"
  1.  .S DIR("A")="CLOSE REASON"
  1.  .D ^DIR
  1.  .Q:($G(DTOUT)!$G(DUOUT))
  1.  .W !,"ABOUT TO CLOSE THIS CLAIM WITH REASON "_Y
  1.  .S ABSPCLSD=$$UPDTCLS(ABSP59,Y)
  1.  .Q
  1.  I ABSPCLSD D
  1.  .N ABSP57 S ABSP57=$$NEW57^ABSPOSU(ABSP59)   ;create an entry in transaction log recording this change
  1.  .W !,"THE CLAIM WAS CLOSED"
  1.  .;S ^TMP("ABSPOS",$J,"PATIENT")=ABSPDFN
  1.  W:'ABSPCLSD !,"THE CLAIM WAS *NOT* CLOSED"
  1.  Q ABSPCLSD
  1.  ;
  1. UPDTCLS(ABSP59,ABSPRSN)  ;UPDATE ^ABSPT WITH CLOSED STATUS, USER INFO, DATE AND REASON
  1.  N ABSPNOW,ABPDUZ,ABSPCLM,ABSPDUZ,ABSPRET,ABSPLOCK,DIE,DR,DA,%,Y,DIC,ABSPDFN
  1.  D NOW^%DTC
  1.  S ABSPRET=0
  1.  S ABSPNOW=%
  1.  S ABSPDUZ=DUZ
  1.  S ABSPDFN=$P($G(^ABSPT(ABSP59,0)),U,6)
  1.  S ABSPCLM=$P($G(^ABSPT(ABSP59,0)),U,4)
  1.  W !,"Updating Claim '"_ABSPCLM
  1.  ;Q:'ABSPCLM ABSPRET
  1.  ;L +^ABSPC(ABSPCLM):0
  1.  L +^ABSPT(ABSP59):3
  1.  S ABSPLOCK=$T
  1.  I ABSPLOCK D
  1.  .S DIE="^ABSPT("
  1.  .S DA=ABSP59
  1.  .;S DR="901///1;902////"_ABSPNOW_";903////"_ABSPDUZ_";906///"_ABSPRSN
  1.  .S DR="7////"_ABSPNOW_";901///1;902////"_ABSPNOW_";903////"_ABSPDUZ_";906///"_ABSPRSN
  1.  .D ^DIE
  1.  .L -^ABSPT(ABSP59)
  1.  .S ABSPRET=1
  1.  .Q
  1.  I 'ABSPLOCK W !,"ANOTHER USER IS EDITING THIS ENTRY. TRY AGAIN LATER"
  1.  ;S ^TMP("ABSPOS",$J,"PATIENT")=ABSPDFN
  1.  Q ABSPRET
  1.  ;
  1. OPENCLM()  ;re-open claim display driver
  1.  N ABSP59,ABSPRSLT,ABSPDONE,Y,ABSPTXN,ABSPDFN,DIR
  1.  S ABSPRSLT=0
  1.  W !,!
  1.  S ABSPDONE=0
  1.  F  Q:ABSPDONE  D
  1.  .S ABSPDFN=$$CLSDPAT()
  1.  .I ABSPDFN<1 S ABSPDONE=1 Q
  1.  .I ABSPDFN=0 Q
  1.  .S ABSPTXN=$$CLSDTXN(ABSPDFN)
  1.  .I 'ABSPTXN S ABSPDONE=1 Q
  1.  .S ABSPRSLT=$$UPDTOPN(ABSPTXN)
  1.  .S DIR(0)="Y"
  1.  .S DIR("B")="NO"
  1.  .S DIR("A")="RE-OPEN more claims"
  1.  .D ^DIR
  1.  .I $G(DTOUT)!$G(DUOUT)!'$G(Y) S ABSPDONE=1 Q
  1.  .W:ABSPRSLT !,"Done.",!
  1.  H 1
  1.  Q ABSPRSLT
  1.  ;
  1. UPDTOPN(ABSP59)  ;UPDATE ^ABSPT WITH OPEN STATUS, USER INFO, DATE
  1.  N ABSPNOW,ABPDUZ,ABSPCLM,ABSPRET,ABSPLOCK,DIE,DR,DA,%,Y,DIC
  1.  N DIR
  1.  S DIR("A")="RE-OPEN THIS CLAIM"
  1.  S DIR(0)="Y",DIR("B")="YES"
  1.  D ^DIR
  1.  Q:'+Y
  1.  D NOW^%DTC
  1.  S ABSPRET=0
  1.  S ABSPNOW=%
  1.  S ABSPDUZ=DUZ
  1.  W !," ***Re-opening Claim*** "_ABSP59
  1.  L +^ABSPT(ABSP59):3
  1.  S ABSPLOCK=$T
  1.  I ABSPLOCK D
  1.  .S DIE="^ABSPT("
  1.  .S DA=ABSP59
  1.  .S DR="7////"_ABSPNOW_";901////0;904////"_ABSPNOW_";905////"_ABSPDUZ
  1.  .D ^DIE
  1.  .L -^ABSPT(ABSP59)
  1.  .N ABSP57 S ABSP57=$$NEW57^ABSPOSU(ABSP59)   ;create an entry in transaction log recording this change
  1.  .S ABSPRET=1
  1.  .Q
  1.  I 'ABSPLOCK W !,"ANOTHER USER IS EDITING THIS ENTRY. TRY AGAIN LATER"
  1.  Q ABSPRET
  1. CLSDPAT()  ;display patients that have POS transaction
  1.  N DIC,ABSPDUZ2
  1.  S ABSPDUZ2=DUZ(2)
  1.  S DUZ(2)=0  ;TO ALLOW USERS TO SELECT FROM ALL LOCATIONS
  1.  S DIC=2,DIC(0)="AEMQZ",DIC("A")="Select Closed Claims for which patient? "
  1.  S DIC("S")="I $D(^ABSPT(""AC"",Y))"
  1.  D ^DIC W !
  1.  S DUZ(2)=ABSPDUZ2 ; Restore original DUZ(2) ; ABSP*1.0T7*7
  1.  S ABSPDFN=+Y
  1.  Q ABSPDFN
  1.  ;
  1. CLSDTXN(ABSPDFN)  ;display closed transactions for identified patient
  1.  N ABSPTXN,DIR,ABSPRTRN,ABSPARRY,ABSPQUIT,ABSPCNT
  1.  S ABSPCNT=0
  1.  S ABSPQUIT=0
  1.  S ABSPRTRN=0
  1.  S ABSPTXN=""
  1.  S DIR(0)="SO^"
  1.  F  S ABSPTXN=$O(^ABSPT("AC",ABSPDFN,ABSPTXN)) Q:ABSPTXN=""  D
  1.  .I $P($G(^ABSPT(ABSPTXN,9)),U,1)=1 D
  1.   ..S ABSPCNT=ABSPCNT+1
  1.   ..S DIR(0)=DIR(0)_ABSPCNT_":"_ABSPTXN_";"
  1.   ..S ABSPARRY(ABSPCNT)=ABSPTXN
  1.   ..S ABSPUSR=$P($G(^ABSPT(ABSPTXN,9)),U,3)
  1.   ..S ABSPRSN=$P($G(^ABSPT(ABSPTXN,9)),U,6)
  1.   ..;IHS/OIT/CASSEVERN/RAN - 12/16/2010 - Patch 40 Added Product Not Covered as valid Reason for closure
  1.   ..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")
  1.   ..W !!,ABSPTXN,!," Closed on "
  1.   ..S Y=$P($G(^ABSPT(ABSPTXN,9)),U,2)
  1.   ..D DT^DIO2  ;this writes out a well formatted date...believe it or not...
  1.   ..W !,"      By: "_$P($G(^VA(200,ABSPUSR,0)),U,1)_"      Close Reason: "_ABSPRSN
  1.  .Q
  1.  I DIR("0")="SO^" D
  1.  .S DIR("B")="NO"
  1.  .S DIR("A")="Would you like to look for another patient"
  1.  .S DIR("A",1)="No CLOSED transactions found for this patient"
  1.  .S DIR("0")="Y"
  1.  .D ^DIR
  1.  .I +Y S ABSPRTRN=0
  1.  .S ABSPQUIT=1
  1.  Q:ABSPQUIT ABSPRTRN
  1.  I DIR("0")'="SO^" D
  1.  .S DIR("B")="1"
  1.  .S DIR("A")="Select CLOSED transaction to RE-OPEN"
  1.  .D ^DIR
  1.  .Q:$G(DTOUT)!$G(DUOUT)
  1.  .S:$G(Y) ABSPRTRN=ABSPARRY(+Y)
  1.  Q ABSPRTRN