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

ACRFSSA1.m

Go to the documentation of this file. 
  1. ACRFSSA1 ;IHS/OIRM/DSD/THL,AEF - AUXILLIARY SUB-ROUTINES FOR ACRFSS* ROUTINES;  [ 07/20/2006  9:58 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,5,20**;NOV 05, 2001
  1.  ;;CONTINUATION OF ACRFSSA
  1. TA ;EP;
  1.  N ACRQTA   ;ACR*2.1*3.25
  1.  N ACRTAMT  ;ACR*2.1*5.10
  1.  N ACRADVR  ;ACR*2.1*5.10
  1.  D ADVANCE
  1.  Q:$D(ACRQTA)   ;HAS OUTSTANDING ADVANCE               ;ACR*2.1*3.25
  1.  S ACRADVR=$$ADVR^ACRFSSA1(ACRDOCDA,ACRTAMT,ACRADV)    ;ACR*2.1*5.10
  1.  W !!,"ALLOWABLE TRAVEL ADVANCE: ",$J($FN(ACRADV,"P",2),8)
  1.  W !,"CURRENT AMOUNT REQUESTED: ",$J($FN(ACRADVR,"P",2),8)  ;ACR*2.1*5.10
  1.  S DIR(0)="YO"
  1.  S DIR("A")="ACCEPT ALLOWABLE ADVANCE"
  1.  S DIR("B")="YES"                                       ;ACR*2.1*5.10
  1.  D DIR^ACRFDIC
  1.  I Y=1 S ACRADV=ACRADVR D ETA Q                         ;ACR*2.1*5.10
  1.  I Y=0 D
  1.  .S DA=ACRDOCDA
  1.  .S DIE="^ACRDOC("
  1.  .S DR="130160T"
  1.  .D DIE^ACRFDIC
  1.  .I $D(^ACRDOC(ACRDOCDA,"TO")),$P(^("TO"),U,25) S ACRADV=$P(^("TO"),U,25) D
  1.  ..S DA=ACRDOCDA
  1.  ..S DIE="^ACROBL("
  1.  ..S DR="1000////"_ACRADV
  1.  ..D DIE^ACRFDIC
  1.  ..D OTA                                               ;ACR*2.1*5.10
  1.  Q
  1. OTA ;EP;RECORD OUTSTANDING TRAVEL ADVANCE
  1.  I '$D(^ACROTA(ACRDOCDA,0)) D
  1.  .N ACRNOW
  1.  .D NOW^%DTC
  1.  .S ACRNOW=%
  1.  .S (DINUM,X)=ACRDOCDA
  1.  .S DIC="^ACROTA("
  1.  .S DIC(0)="LZ"
  1.  .S DIC("DR")=".02////"_$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9)
  1.  .D FILE^ACRFDIC
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACROTA("
  1.  S DR=".03////"_ACRADV
  1.  D DIE^ACRFDIC
  1.  I +$G(^ACROBL(ACRDOCDA,"TA"))'=ACRADV D
  1.  .S DA=ACRDOCDA
  1.  .S DIE="^ACROBL("
  1.  .S DR="1000////"_ACRADV
  1.  .D DIE^ACRFDIC
  1.  I $P($G(^ACRDOC(ACRDOCDA,"TO")),U,25)'=ACRADV D
  1.  .S DA=ACRDOCDA
  1.  .;I '$D(ACRTAMT) S ACRTAMT=ACRADV/.8 S:ACRADV=0 ACRTAMT=0  ;ACR*2.1*5.10;ACR*2.1*20.08  IM18616
  1.  .I '$D(ACRTAMT) S ACRTAMT=ACRADV/.6 S:ACRADV=0 ACRTAMT=0  ;ACR*2.1*5.10;ACR*2.1*20.08  IM18616
  1.  .S DIE="^ACRDOC("
  1.  .S DR="130160///"_ACRADV
  1.  .D DIE^ACRFDIC
  1.  Q
  1. TOTAL ;EP;
  1.  I $P(^ACRDOC(ACRDOCDA,"TO"),U,22)=1 D
  1.  .S ACRATM=ACRREIM-ACRLDG-ACRRC-ACRPHN-ACR4P-$S($P(^ACRDOC(ACRDOCDA,"TOAU"),U,5)=1:$G(ACRALTOT),1:0)
  1.  .S ACRATM=$P(ACRATM,".")
  1.  .S ACRATMX=$E(ACRATM,$L(ACRATM))
  1.  .S:ACRATMX#10 ACRATM=ACRATM+(10-ACRATMX)
  1.  .S:$E(ACRATM,$L(ACRATM)-1)#2 ACRATM=ACRATM+10
  1.  .S ACRATM1=$S(ACRREFX=600:$P(^ACRDOC(ACRDOCDA,"TO"),U,23),1:ACRATM)
  1.  .S ACRATM2=$P(^ACRDOC(ACRDOCDA,"TOAU"),U,8)
  1.  .W !!,"GOVERNMENT ATM CASH WITHDRAWAL ",$S(ACRREFX=600:"AUTHORIZED",1:"ESTIMATED."),": ",$J($FN(ACRATM1,"P",2),10)
  1.  .W !,"GOVERNMENT ATM CASH WITHDRAWAL ",$S(ACRREFX=600:"TAKEN.....",1:"REQUESTED."),": ",$J($FN(ACRATM2,"P",2),10)
  1.  .W !,"GOVERNMENT ATM SERVICE CHARGE  ",$S(ACRREFX=600:"AUTHORIZED",1:"EXPECTED.."),": ",$J($FN($S(ACRREFX=600:$P(^ACRDOC(ACRDOCDA,"TO"),U,26),1:ACRATM*$P(^ACRSYS(1,"DT"),U,16)),"P",2),10)
  1.  .W !,"YOU ARE REQUIRED TO ABIDE BY THE MAX ATM WITHDRAWAL LIMITS OF $60/DAY, $360/WEEK"
  1.  W $$DASH^ACRFMENU
  1.  W !
  1.  W:$D(ACRALTOT) "AIRLINE.: ",$J($FN(ACRALTOT,"P",2),8)
  1.  W:$D(ACRRC) ?25,"RENTAL CAR: ",$J($FN(ACRRC,"P",2),8)
  1.  W ?54,"TOTAL EXPENSES: ",$J($FN(ACRTOT,"P",2),9)
  1.  W !,"PER DIEM: ",$J($FN(ACRPD+ACRLDG,"P",2),8)
  1.  W ?25,"OTHER.....: ",$J($FN(ACROTHT,"P",2),8)
  1.  W ?54,$S(ACRREF=130:"EXCLD AIRLINE.: ",1:"REIMBURSABLE..: "),$J($FN(ACRREIM-$P($G(^ACROTA(ACRDOCDA,0)),U,3),"P",2),9)
  1.  W !,"TM FEE..: ",$J($FN($$TMFEE^ACRFSS42(ACRDOCDA),"P",2),8)
  1.  W ?54,"TRAVEL ADVANCE: ",$J($FN($P(^ACRDOC(ACRDOCDA,"TO"),U,25),"P",2),9)
  1.  I $P($G(^ACRDOC(ACRDOCDA,"TRNG4")),U,16) W !?48,"TOTAL NOT TO EXCEED.: ",$J($FN($P(^("TRNG4"),U,16),"P",2),9) S:ACRTOT>$P(^("TRNG4"),U,16) ACRTOT=$P(^("TRNG4"),U,16)
  1.  W:$D(ACRPRT)&(ACRREF'=130) !?48,"TOTAL AMOUNT CLAIMED: ",$J($FN(ACRTOT-ACRADV,"P",2),9)
  1.  I ACRREF'=130,$P($G(^ACRDOC(ACRDOCDA,"TOAU")),U,7) D
  1.  .S ACROBL=$P(^ACRDOC(ACRDOCDA,"TOAU"),U,7)
  1.  .W !?48,"ORIGINALLY OBLIGATED: ",$J($FN(ACROBL,"P",2),9)
  1.  .I ACRTOT>ACROBL D
  1.  ..W !?48,"UNDER-OBLIGATED.....: ",$J($FN(ACRTOT-ACROBL,"P",2),9)
  1.  D PAUSE^ACRFWARN:'$D(ACRQUIT)
  1.  D UP^ACRFSS3
  1.  K ACRTV("D")
  1.  Q
  1. CHK ;EP;CHECK TO SEE IF ANY SIGNATURES HAVE BEEN APPLIED TO THE TRAVEL
  1.  ;VOUCHER CHECK FOR CHANGE TO TRAVEL DAYS AFTER TRAVEL VOUCHER SIGNED
  1.  Q:'$D(^ACRAPVS("AB",ACRDOCDA))
  1.  N ACR
  1.  S ACRAPVDA=0
  1.  F  S ACRAPVDA=$O(^ACRAPVS("AB",ACRDOCDA,ACRAPVDA)) Q:'ACRAPVDA  I $D(^ACRAPVS(ACRAPVDA,0)),$P(^(0),U,3)=39,$E($G(^ACRAPVS(ACRAPVDA,"DT")))="A" S ACRTVCH="" Q
  1.  Q
  1. ADVANCE ;EP;UPDATE TRAVEL ADVANCE AMOUNT DURING TRAVEL ORDER PROCESSING
  1.  Q:$O(^AUTTDOCR("B","130",0))'=+$P(^ACRDOC(ACRDOCDA,0),U,13)
  1.  S ACRLDG=$G(ACRLDG)  ;ACR*2.1*3.35
  1.  S ACRRC=$G(ACRRC)  ;ACR*2.1*3.35
  1.  S ACROTHT=$G(ACROTHT)  ;ACR*2.1*3.35
  1.  N ACRDUZ
  1.  S ACRDUZ=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9)
  1.  Q:'ACRDUZ
  1.  D OUTSTD^ACRFTA
  1.  I $G(ACR9E) D  Q
  1.  .K ACR9E
  1.  .W !,"It appears that the traveler has an outstanding travel advance."
  1.  .W !,"No additional advance can be requested until the outstanding"
  1.  .W !,"advance is liquidated."
  1.  .S ACRQTA=1           ;SET QUIT FLAG ;ACR*2.1*3.25
  1.  .D PAUSE^ACRFWARN
  1.  N ACRTO
  1.  S ACRTO=^ACRDOC(ACRDOCDA,"TO")
  1.  I $P(ACRTO,U,22)=0,$P(ACRTO,U,19)="Y" D  I 1
  1.  .S ACRTAMT=ACROTHT+ACRPD+ACRLDG+ACRRC   ;ACR*2.1*5.10
  1.  .;S ACRADV=.8*ACRTAMT                    ;ACR*2.1*5.10;ACR*2.1*20.08  IM18616
  1.  .S ACRADV=.6*ACRTAMT                    ;ACR*2.1*5.10;ACR*2.1*20.08  IM18616
  1.  .S ACRADV=$P(ACRADV,".")
  1.  .;S ACRADVX=$E(ACRADV,$L(ACRADV))       ;ACR*2.1*5.10
  1.  .;S ACRADV=($E(ACRADV,1,$L(ACRADV)-1)_0)+$S(ACRADVX>4:10,1:0)  ;ACR*2.1*5.10
  1.  E  S (ACRADV,ACRTAMT)=0                 ;ACR*2.1*5.10
  1.  Q
  1. ALTOT ;EP;TO CALCULATE TOTAL AIRLINE EXPENSE
  1.  Q:'$D(^ACRAL("E",ACRDOCDA))
  1.  S (ACRALTOT,ACRALDA)=0
  1.  F  S ACRALDA=$O(^ACRAL("E",ACRDOCDA,ACRALDA)) Q:'ACRALDA  D
  1.  .S ACRALTOT=ACRALTOT+$P($G(^ACRAL(ACRALDA,"DT")),U,9)
  1.  .S:+$P($G(^ACRAL(ACRALDA,"DT")),U,11)>0 ACRCONC=$P(^ACRAL(ACRALDA,"DT"),U,11)
  1.  Q
  1. ETA ;EP;TO EDIT/UPDATE TRAVEL ADVANCE
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACROBL("
  1.  S DR="1000////"_ACRADV
  1.  D DIE^ACRFDIC
  1.  S DA=ACRDOCDA
  1.  ;I '$D(ACRTAMT) S ACRTAMT=ACRADV/.8 S:ACRADV=0 ACRTAMT=0 ;ACR*2.1*5.10;ACR*2.1*20.08  IM18616
  1.  I '$D(ACRTAMT) S ACRTAMT=ACRADV/.6 S:ACRADV=0 ACRTAMT=0 ;ACR*2.1*5.10;ACR*2.1*20.08  IM18616
  1.  S DIE="^ACRDOC("
  1.  S DR="130160////"_ACRADV
  1.  D DIE^ACRFDIC
  1.  D OTA                                                   ;ACR*2.1*5.10
  1.  Q
  1. ADVR(ACRDOCDA,ACRTAMT,ACRADV) ;LOCAL ENTRY; EXTRINSIC FUNCTION   ;ACR*2.1*5.10
  1.  ;          ENTERS WITH: DOCUMENT IEN
  1.  ;                       AMOUNT BEFORE MINU 8 %     
  1.  ;                       ALLOWABLE ADVANCE
  1.  ;          RETURNS:     ADVANCE AMOUNT
  1.  ;                       ADJUSTED IF GREATER THAN TAMT-5.00
  1.  ;
  1.  S ACRADVR=+$P($G(^ACRDOC(ACRDOCDA,"TO")),U,25)
  1.  I ACRADVR=0 S ACRADVR=ACRADV
  1.  I ACRADVR'>0 Q 0
  1.  I ACRADVR>(ACRTAMT-5) D
  1.  .W !,"Requested advance cannot be greater than the total allowed amount, less $5.00"
  1.  .W !,"Adjusting the amount to the greatest amount allowed."
  1.  .S ACRADVR=ACRTAMT-5
  1.  .D PAUSE^ACRFWARN
  1.  Q ACRADVR