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

ACHSAC.m

Go to the documentation of this file. 
  1. ACHSAC ; IHS/ITSC/PMF - CANCEL CHS DOCUMENTS ;    [ 02/18/2004  8:49 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**4,7,8**;JUN 11, 2001
  1.  ;ACHS*3.1*4  correct spelling of Cancellation
  1.  ;ACHS*3.1*7 Cancel a document and remove it from E-Sig queue
  1.  ;ACHS*3.1*8 Cancel a document and remove it from E-Sig queue
  1.  ;
  1.  ;
  1. A1 ;
  1.  ;I HATE doing this, but for right now, it's the only answer.
  1.  ;Somehow the user finds a way to enter here so that the basic
  1.  ;vars don't get set.  So we will check for the current fiscal
  1.  ;year and if it is not set, we gonna set it along with the
  1.  ;financial code.   4/13/01   pmf
  1.  I '$D(ACHSCFY) D FY^ACHSUF,FC^ACHSUF
  1.  ;
  1.  D ^ACHSUSC                             ;DISPLAY DOC. CANCEL/SUPP. INFO.
  1.  I $D(DTOUT)!$D(DUOUT)!'$D(ACHSDIEN) D QUIT Q
  1.  W !
  1.  I '$$LOCK^ACHS("^ACHSF(DUZ(2),""D"",ACHSDIEN)","+") D ENDC Q
  1.  ;
  1.  S ACHSX=+$$DOC^ACHS(0,14)               ;FISCAL YEAR DIGIT
  1.  D FYCVT^ACHSFU                          ;COMPUTE FISCAL YEAR
  1.  S ACHSACFY=ACHSY
  1.  S ACHSACWK=+ACHSFYWK(DUZ(2),ACHSACFY)
  1.  ;
  1.  D CKB^ACHSUUP                           ;CHECK BALANCES
  1.  ;
  1.  I $D(ACHSCNC) D ENDC Q                  ;BALANCES OUT OF SYNCH QUIT
  1. B1 ;
  1.  ;
  1.  G C1:$$DIR^XBDIR("Y","Do You Wish To Cancel The Entire Document","NO","","  You May Cancel All ($"_ACHSBAL_") or Part Of The Obligation.","",2)
  1.  I $D(DTOUT) D ENDC Q
  1.  G A1:$D(DUOUT)
  1.  ;
  1. B2 ;
  1.  ;ACHS*3.1*4   4/19/02   pmf  correct spelling
  1.  ;S Y=$$DIR^XBDIR("FO","Amount Of Cancelation","","","Enter The Amount To Be Canceled (e.g.  150.00).","",2)  ;  ACHS*3.1*4
  1.  S Y=$$DIR^XBDIR("FO","Amount Of Cancellation","","","Enter The Amount To Be Canceled (e.g.  150.00).","",2)  ;  ACHS*3.1*4
  1.  ;
  1.  ;
  1.  I $D(DTOUT) D ENDC Q
  1.  G B1:$D(DUOUT)
  1.  ;
  1.  I +Y=0 W *7,"   NO Amount Canceled",!! G A1
  1.  S:Y?1"$".E Y=$E(Y,2,99)
  1.  F I=1:1 S F=$F(Y,",") Q:'F  S Y=$E(Y,1,F-2)_$E(Y,F,99)
  1.  I '(Y?1N.N1"."2N!(Y?1N.N))!($L(Y)>10) W *7,"  ??" G A1
  1.  S Y=$J(Y,1,2)
  1.  I Y'<ACHSBAL W *7,"  ??",!,"  Must Be Less Than $",ACHSBAL,", Which Is the Current Obligation Balance." G B2
  1.  S ACHSESDO=Y,ACHSFULP="P"
  1.  W "   ($",$FN(Y,",",2),")"
  1.  G OK
  1.  ;
  1. C1 ;
  1.  S ACHSESDO=$J(ACHSBAL,1,2),ACHSFULP="F"
  1.  S ACHSCANR=$$DIR^XBDIR("9002080.01,63","","UNKNOWN")
  1.  I $D(DIRUT) D ENDC Q
  1.  G B1:$D(DUOUT)
  1. OK ;
  1.  S Y=$$DIR^XBDIR("Y","Is everything correct","NO","","","",2)
  1.  I $D(DIRUT) D ENDC Q
  1.  G B1:$D(DUOUT)!('Y)
  1. D1 ;
  1.  S T=DT_"^C^"_$G(DFN)_U_ACHSESDO_U_ACHSFULP
  1.  S ACHSESDO=ACHSESDO*-1
  1.  D CKB^ACHSUUP                          ;CHECK BALANCES
  1.  I $D(ACHSCNC) D ENDC Q
  1.  ;
  1.  D SB1                                  ;SET THE NEW TRANSACTION RECORD
  1.  ;
  1.  W !!," *** Document Updated  ***"
  1.  D ACT^ACHSACT(ACHSDIEN,$$NOW^XLFDT,"<CANCELATION>")
  1.  I $$DOC^ACHS(2,7) S ACHSREF=$$DOC^ACHS(2,7) D AUTH^ACHSBMC K ACHSREF
  1. ENDC ;
  1.  I $$LOCK^ACHS("^ACHSF(DUZ(2),""D"",ACHSDIEN)","-")
  1.  I $$DIR^XBDIR("E","Press RETURN...")
  1. QUIT ;
  1.  K X,X1,X2
  1.  D EN^XBVK("ACHS"),^ACHSVAR
  1.  Q
  1.  ;
  1.  ;AGAIN SET THE TRANSACTION RECORD BYPASSING FILEMAN COMPLETELY???????
  1. SB1 ;
  1.  S X=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,0))
  1.  S ACHSLCA=+$P(X,U,16)
  1.  S:'$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",0)) ^ACHSF(DUZ(2),"D",ACHSDIEN,"T",0)=$$ZEROTH^ACHS(9002080,100,100)
  1.  S Y=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",0))
  1. S11 ;
  1.  S M=$P(Y,U,3)+1,$P(Y,U,3)=M,$P(Y,U,4)=M
  1.  G S11:$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",M))
  1.  S ^ACHSF(DUZ(2),"D",ACHSDIEN,"T",0)=Y      ;
  1.  S ^ACHSF(DUZ(2),"D",ACHSDIEN,"T",M,0)=T    ;
  1.  S ^ACHSF(DUZ(2),"TB",DT,"C",ACHSDIEN,M)=""
  1.  S ACHSTIEN=M
  1.  S ACHSDCR=-1
  1.  ;
  1.  S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",M,0),U,7)=ACHSLCA+1  ;'CANCEL NUMBER'
  1.  S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,16)=ACHSLCA+1 ;'LAST CANCEL NUMBER'
  1.  S ACHSDCR=$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,0)),U,19) ;'DCR ACCOUNT NUMBER'
  1.  S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",M,0),U,11)=DUZ
  1.  I ACHSDCR<1 W !,"ERROR: No DCR account number in DOCUMENT record... ",!! W:$$DIR^XBDIR("E","Press RETURN...") "" Q
  1.  S ACHS("CHK")=0
  1.  D SBAENT^ACHSUUP                    ;Update Current Advice of
  1.                                      ;Allowance and Total Obligated FYTD
  1.  ;
  1.  D SBQ^ACHSUUP:$$PARM^ACHS(2,6)="Y"  ;PLACE DOCUMENT IN PRINT QUE
  1.                                      ;IF 'PRINT CANCEL DOCUMENTS'
  1.  ;ITSC/SET/JVK ACHS*3.1*7 11.21.03 NXT TWO LINES
  1.  S ACHSTYP=$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,0)),U,4)
  1.  ;I $D(^ACHSF("EQ",DUZ(2),ACHSTYP,ACHSDIEN,1)) K ^ACHSF("EQ",DUZ(2),ACHSTYP,ACHSDIEN,1)
  1.  ;ITSC/SET/JVK ACHS*3.1*8 1/20/04-LN BELOW
  1.  I $D(^ACHSF("EQ",DUZ(2),ACHSTYP,ACHSDIEN)) K ^ACHSF("EQ",DUZ(2),ACHSTYP,ACHSDIEN)
  1.  ;
  1.  ;SET 'COMMENTS (OPTIONAL)'
  1.  S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,12)=$S(ACHSFULP="P":2,1:4)
  1.  ;SET 'CANCELLATION REASON'
  1.  I $L($G(ACHSCANR)),$$DIE^ACHS("63////"_ACHSCANR)
  1.  Q
  1.  ;