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

ACHSAS.m

Go to the documentation of this file. 
  1. ACHSAS ; IHS/ITSC/PMF - SUPPLEMENTAL DOCUMENTS ;    [ 10/16/2001   8:16 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1. A1 ; Setup environment.
  1.  ;
  1.  D ^ACHSUSC              ;DISPLAY DOC. CANCEL/SUPPLEMENT INFO
  1.  I $D(DUOUT) D ENDC Q
  1.  Q:'$D(ACHSDIEN)
  1.  ;
  1.  W !
  1.  I '$$LOCK^ACHS("^ACHSF(DUZ(2),""D"",ACHSDIEN)","+") D ENDC Q
  1.  ;
  1.  ;
  1.  S ACHSX=+$$DOC^ACHS(0,14)          ;GET FISCAL YEAR DIGIT
  1.  D FYCVT^ACHSFU                     ;COMPUTE FISCAL YEAR
  1.  S ACHSACFY=ACHSY,ACHSACWK=+ACHSFYWK(DUZ(2),ACHSACFY)
  1.  D CKB^ACHSUUP                      ;CHECK BALANCES
  1.  I $D(ACHSCNC) D END Q              ;QUIT IF BALANCES DONT CHECK
  1.  ;
  1. B2 ; Enter ammount of suplement.
  1.  W !!,"Amount Of Supplement: "
  1.  D READ^ACHSFU
  1.  I $D(DTOUT) D ENDC Q
  1.  G A1:$D(DUOUT)
  1.  ;
  1.  I Y?1"?".E W !,"  Enter The Amount To Be Added (e.g.  150.00)." G B2
  1.  I Y="" W *7,"   NO AMOUNT ADDED",!!
  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.  ;
  1.  S ACHSADAM=Y D OBLM^ACHSFU  ;CHECK IF OBLIGATION LIMIT FOR
  1.  ;                           ;THIS TYPE DOC. IS EXCEEDED
  1.  G:$D(DUOUT) B2
  1.  ;
  1. C ; Confirm data.
  1.  S ACHSESDO=Y
  1.  W "   ("
  1.  S X=ACHSESDO
  1.  D FMT^ACHS
  1.  W ")"
  1.  S Y=$$DIR^XBDIR("Y","Is everything correct","NO","","","",2)
  1.  I $D(DIRUT) D ENDC Q
  1.  G B2:$D(DUOUT)!('Y)
  1.  ;
  1. D1 ; Create internal transaction.
  1.  D SBA                   ;CHECK FOR FUNDS AVAILABLE
  1.  I $D(ACHSCNC) D ENDC Q  ;IS CANCEL FLAG SET?
  1.  ;
  1.  S T=DT_"^S^"_$G(DFN)_U_ACHSESDO
  1.  ;
  1.  D SB1                    ;CREATE TRANSACTION RECORD
  1.  ;
  1. END ;
  1.  I '$D(ACHSCNC) W !!," ***  Document Updated  ***" D ACT^ACHSACT(ACHSDIEN,$$NOW^XLFDT,"<SUPPLEMENTAL>")
  1.  I $$DOC^ACHS(2,7) S ACHSREF=$$DOC^ACHS(2,7) D AUTH^ACHSBMC K ACHSREF
  1. ENDC ;
  1.  I $G(ACHSDIEN),$$LOCK^ACHS("^ACHSF(DUZ(2),""D"",ACHSDIEN)","-")
  1.  I $$DIR^XBDIR("E","Press RETURN...","","","","",1)
  1. QUIT ; Kill vars, quit.
  1.  K X,X1,X2
  1.  Q
  1.  ;
  1.  ;SET THE TRANSACTION RECORD BYPASSING FILEMAN ???????
  1. SB1 ;
  1.  S X=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,0)),ACHSDCR=-1,LS=+$P(X,U,15),ACHSDCR=$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,0)),U,19)
  1.  I ACHSDCR<1 W !,"ERROR :Unknown DCR account number." Q
  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,^ACHSF(DUZ(2),"D",ACHSDIEN,"T",M,0)=T,^ACHSF(DUZ(2),"TB",DT,"S",ACHSDIEN,M)="",ACHSTIEN=M
  1.  S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",M,0),U,6)=LS+1,$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,15)=LS+1
  1.  S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",M,0),U,11)=DUZ
  1.  S ACHS("CHK")=0
  1.  D SBAENT^ACHSUUP
  1.  D SKILL:$D(ACHSCNC)
  1.  D SBQ^ACHSUUP:$$PARM^ACHS(2,7)="Y"
  1.  Q
  1.  ;
  1. SKILL ;
  1.  S X=$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",0)),U,3)
  1.  S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",0),U,3)=X-1
  1.  S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",0),U,4)=X-1
  1.  K ^ACHSF(DUZ(2),"D",ACHSDIEN,"T",M),^ACHSF(DUZ(2),"TB",DT,"S",ACHSDIEN,M)
  1.  S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,15)=LS
  1.  Q
  1.  ;
  1. SBA ; Check for funds available.
  1.  I '$$LOCK^ACHS("^ACHS(9,DUZ(2))","+") W !,"LOCK UNSUCCESSFUL, SBA^ACHSAS." S ACHSCNC="" Q
  1.  S X=$G(^ACHS(9,DUZ(2),"FY",ACHSACFY,0))  ;
  1.  S X1=$P(X,U,2)                       ;CURRENT ADVICE OF ALLOWANCE
  1.  S X2=$P(X,U,3)                       ;TOTAL OBLIGATED FYTD
  1.  I '$$LOCK^ACHS("^ACHS(9,DUZ(2))","-")
  1.  I $$PARM^ACHS(2,2)="Y",ACHSACFY<ACHSCFY Q
  1.  I X2+ACHSESDO>X1 W *7,!,"Funds are not available for this transaction",!,"Transaction Cancelled" S ACHSCNC=""
  1.  Q
  1.  ;