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

DGBTCE1.m

Go to the documentation of this file. 
  1. DGBTCE1 ;ALB/LM - BENEFICIARY TRAVEL CLAIM RE-ENTER/EDIT CONT.; 9/13/89@8:00 ;4/23/91  09:42
  1.  ;;1.0;Beneficiary Travel;**17,20**;September 25, 2001;Build 185
  1.  Q
  1. CONT ; ENTRY POINTS FROM DGBTEE,DGBTCE
  1.  N MOSTENC
  1.  F I=0,"A","C","D","M","R","T" S DGBTVAR(I)=$S($D(^DGBT(392,DGBTDT,I)):^(I),1:"")
  1.  I DGBTDE<0 S DGBTDE=0
  1.  I $G(DGBTCCREQ) S DGBTFLX=" DEDUCTIBLE AMOUNT HAS BEEN CHANGED " I DGBTACCT=4 S DGBTPA=$S(DGBTTC-DGBTDE>0:DGBTTC-DGBTDE,DGBTTC-DGBTDE<0:DGBTTC,1:0)
  1. DIE5 ;S DGBTINFL=$S(DGBTDE=DGBTDCV:$P(DGBTVAR("R"),DGBTFLX)_$P(DGBTVAR("R"),DGBTFLX,2)_" ",DGBTDE'=DGBTDCV&(DGBTVAR("R")'[DGBTFLX):$E(DGBTVAR("R")_DGBTINFL_DGBTFLX,1,79),1:DGBTVAR("R"))
  1.  S MOSTENC=$$GET1^DIQ(392,DGBTDT,8)
  1.  S DGBTPA=$P(DGBTVAR(0),"^",10)
  1.  I $G(DGBTCCREQ) S DGBTPA=$S($G(MOSTENC)>0&(MOSTENC<DGBTPA):MOSTENC,1:DGBTPA),DGBTPA=$S(DGBTPA-$G(DGBTDE)<0:0,1:DGBTPA)   ;$P(DGBTVAR(0),"^",9)
  1.  I '$G(DGBTCCREQ),'$G(MOSTENC) D
  1.  .S DGBTPA=$P(DGBTVAR("C"),"^",2)+$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR("M"),"^",5)
  1.  .I $P(DGBTVAR("M"),"^",3)-$G(DGBTDCV1)>0 S DGBTPA=DGBTPA+(DGBTMLT-$G(DGBTDE))
  1.  .I $P(DGBTVAR("M"),"^",3)-$G(DGBTDCV1)<0 S DGBTPA=DGBTPA
  1.  ;    stuff amount payable
  1.  I DGBTFLAG=2 W !!,"DEDUCTIBLE AMOUNT CAN NOT EXCEED THE TOTAL COSTS FOR THIS CLAIM",! K X S DGBTFLAG=0 G DED1^DGBTCE
  1.  I DGBTFLAG=1 W !!,"DEDUCTIBLE FOR THIS CLAIM CAN NOT EXCEED THE AMOUNT REMAINING FOR THIS MONTH",! K X S DGBTFLAG=0 G DED1^DGBTCE
  1.  ;
  1.  S DIE="^DGBT(392,",DA=DGBTDT,DIE("NO^")="BACK",DR="51"
  1. DIE6 D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=-1 Q
  1.  I ($L(DGBTACCT)=1),("45"[DGBTACCT) D
  1.  .N FDA,ERR
  1.  .S DGBTPA=$$PAYABLE
  1.  .S FDA(392,DGBTDT_",",9)=DGBTDE
  1.  .S FDA(392,DGBTDT_",",10)=DGBTPA
  1.  .D FILE^DIE("E","FDA","ERR")
  1.  .I $D(ERR) S DGBTTOUT=-1
  1.  I $G(DGBTTOUT)=-1 Q
  1.  D QUIT
  1.  D SCREEN^DGBTCD
  1.  Q
  1. QUIT ;KILL VARIABLES
  1.  K DGBTCITY,DGBTSTAT,DGBTWAY,DGBTMILE,DIE,DR,DGBTOWRT,DGBTML,DGBTMLFB,DGBTACCT,DGBTAP,DGBTMAL,DGBTFAB,DGBTME,DGBTMAF,DGBTTC,DGBTDCM,DGBTDPV,DGBTDPM,DGBTDRM,DGBTDCV,DGBTDE,DGBTPA,I,DGBTELIG,DGBTFLAG,DGBTMETC,DGBTMLT,DGBTCP,DGBTMR1
  1.  K DGBTFR1,DGBTFR2,DGBTFR3,DGBTFR4,DGBTTO1,DGBTTO2,DGBTTO3,DGBTTO4,DGBTMR,DGBTRATE,DGBTSCP,DGBTFLX Q
  1. PAYABLE() ;
  1.  N DGBTRAY,FERRIES,MEALS,MILEAGE
  1.  D GETS^DIQ(392,DGBTDT_",","8;33;34;35;55;55.1","EI","DGBTRAY")
  1.  S MEALS=+DGBTRAY(392,DGBTDT_",",34,"I")
  1.  S MILEAGE=+DGBTRAY(392,DGBTDT_",",33,"I")
  1.  S FERRIES=+DGBTRAY(392,DGBTDT_",",35,"I")
  1.  I DGBTDE>MILEAGE S DGBTDE=MILEAGE
  1.  I DGBTRAY(392,DGBTDT_",",55.1,"E")="NO" Q $$COMCARN
  1.  I DGBTRAY(392,DGBTDT_",",55.1,"E")="YES" Q $$COMCARY
  1.  S DGBTPA=MILEAGE+MEALS+FERRIES
  1.  I DGBTDE>DGBTPA Q 0
  1.  Q (DGBTPA-DGBTDE)
  1.  ;
  1. COMCARN() ;CC not required
  1.  N CCFEE,MOSTEC,FDA
  1.  S MOSTEC=+DGBTRAY(392,DGBTDT_",",8,"I")
  1.  I DGBTDE>MILEAGE S DGBTDE=MILEAGE
  1.  I (MOSTEC>0)&(MILEAGE'>0) Q (MOSTEC+MEALS+FERRIES)
  1.  I (MOSTEC>0)&(MOSTEC>MILEAGE) S DGBTPA=(MILEAGE+MEALS+FERRIES)
  1.  I (MOSTEC>0)&(MOSTEC'>MILEAGE) D  Q (MOSTEC+MEALS+FERRIES)
  1.  .S FDA(392,DGBTDT_",",9)=0 S DGBTDE=0
  1.  .D FILE^DIE("E","FDA","ERR")
  1.  I (MOSTEC'>0) S DGBTPA=(MILEAGE+MEALS+FERRIES)
  1.  I DGBTDE>DGBTPA Q 0
  1.  Q (DGBTPA-DGBTDE)
  1.  ;
  1. COMCARY() ; CC required
  1.  N CCFEE,MOSTEC
  1.  S CCFEE=+DGBTRAY(392,DGBTDT_",",55,"I")
  1.  I DGBTDE>MILEAGE S DGBTDE=MILEAGE,MILEAGE=DGBTDE
  1.  S DGBTPA=CCFEE+MILEAGE+MEALS+FERRIES
  1.  S DGBTPA=CCFEE+MEALS+FERRIES+MILEAGE
  1.  I DGBTDE>DGBTPA Q 0
  1.  Q (DGBTPA-DGBTDE)