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

ACRFPAID.m

Go to the documentation of this file. 
  1. ACRFPAID ;IHS/OIRM/DSD/THL,AEF - RECONCILE PAID AMOUNTS; [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  ;;
  1. DOCPAID ;EP;CALCULATE AMOUNT PAID FOR ALL ITEMS ON A DOCUMENT
  1.  N ACRSSDA
  1.  S ACRSSDA=0
  1.  F  S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA  D ITEM
  1.  Q
  1. ITEM ;CALCULATE AMOUNT PAID FOR AN ITEM
  1.  N ACRITOT,ACRRRDA
  1.  S ACRITOT=0
  1.  S ACRRRDA=0
  1.  F  S ACRRRDA=$O(^ACRRR("B",ACRSSDA,ACRRRDA)) Q:'ACRRRDA  D
  1.  .Q:'$P($G(^ACRRR(ACRRRDA,0)),U,11)
  1.  .S X=$G(^ACRRR(ACRRRDA,"DT"))
  1.  .S ACRITOT=ACRITOT+($P(X,U,5)*$P(X,U,6))
  1.  Q:'ACRITOT
  1.  S DA=ACRSSDA
  1.  S DIE="^ACRSS("
  1.  S DR="16.1////"_ACRITOT
  1.  I $G(ACRFINAL)'=1 S $P(^ACRSS(ACRSSDA,"DT"),U,21)=ACRITOT
  1.  E  D DIE^ACRFDIC
  1.  Q
  1. TVPAID ;EP;ENTER TRAVEL EXPENSES PAID
  1.  D ALTOT^ACRFCLM
  1.  S ACRSSDA=0
  1.  F  S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA  D
  1.  .S ACRSS0=$G(^ACRSS(ACRSSDA,0)),ACRSSDT=$G(^ACRSS(ACRSSDA,"DT"))
  1.  .S ACRITOT=$S(+ACRSS0'=1:$P(ACRSSDT,U,9),1:ACRALTOT)
  1.  .S DA=ACRSSDA
  1.  .S DIE="^ACRSS("
  1.  .S DR="16.1////"_ACRITOT
  1.  .D DIE^ACRFDIC
  1.  Q
  1. PAIDUP ;EP;TO UPDATE ARMS WHEN 1166 BATCH IS CERTIFIED
  1.  Q:'$G(ACRFYDA)!'$G(ACRBATDA)
  1.  N ACRBATNO,ACRBTYP
  1.  S ACRBATNO=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
  1.  Q:ACRBATNO=""
  1.  S ACRBTYP=$S("ABCG"[$E(ACRBATNO):"V","DEF"[$E(ACRBATNO):"T",1:"")
  1.  Q:ACRBTYP=""
  1.  N ACRSEQDA
  1.  S ACRSEQDA=0
  1.  F  S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA  D
  1.  .Q:'+$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,"ARMS"))  S ACRDOCDA=+^("ARMS")
  1.  .D DOCPAID:$G(ACRBTYP)="V"
  1.  .D TVPAID:$G(ACRBTYP)="T"
  1.  Q
  1. SYNC ;EP;TO SYNCHRONIZE ARMS FMS DOCUMENT POINTER IN 1166 RECORDS
  1.  D ^XBKVAR
  1.  D DCALC
  1.  D TCALC
  1.  D ODOC
  1.  N ACRDOC
  1.  S ACRDOC=""
  1.  F  S ACRDOC=$O(^AFSLAFP("N",ACRDOC)) Q:ACRDOC=""  D
  1.  .S ACRDOCDA=$O(^ACRDOC("C",ACRDOC,0))
  1.  .I 'ACRDOCDA S ACRDOCDA=$O(^ACRDOC("B",ACRDOC,0))
  1.  .Q:'ACRDOCDA
  1.  .N ACRFYDA
  1.  .S ACRFYDA=0
  1.  .F  S ACRFYDA=$O(^AFSLAFP("N",ACRDOC,ACRFYDA)) Q:'ACRFYDA  D
  1.  ..N ACRBATDA
  1.  ..S ACRBATDA=0
  1.  ..F  S ACRBATDA=$O(^AFSLAFP("N",ACRDOC,ACRFYDA,ACRBATDA)) Q:'ACRBATDA  D
  1.  ...N ACRSEQDA
  1.  ...S ACRSEQDA=0
  1.  ...F  S ACRSEQDA=$O(^AFSLAFP("N",ACRDOC,ACRFYDA,ACRBATDA,ACRSEQDA)) Q:'ACRSEQDA  D
  1.  ....S DA=ACRSEQDA
  1.  ....S DA(2)=ACRFYDA
  1.  ....S DA(1)=ACRBATDA
  1.  ....S DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
  1.  ....S DR=".02////"_ACRDOCDA
  1.  ....D DIE^ACRFDIC
  1.  ....W "*" ;!,ACRDOC,?10,ACRDOCDA,?20,ACRFYDA,?30,ACRBATDA,?40,ACRSEQDA
  1.  Q
  1. DCALC ;EP;CALCULATE ACTUAL PAID AMOUNT FOR ALL DOCUMENTS
  1.  N ACRDOCDA
  1.  S ACRDOCDA=0
  1.  F  S ACRDOCDA=$O(^ACRRR("C",ACRDOCDA)) Q:'ACRDOCDA  D DOCPAID W "."
  1.  Q
  1. TCALC ;EP;TO CALCULATE TRAVEL EXPENSES PAID
  1.  N ACRDOCDA
  1.  S ACRDOCDA=0
  1.  F  S ACRDOCDA=$O(^ACRDOC("REF",133,ACRDOCDA)) Q:'ACRDOCDA  I $P($G(^ACROBL(ACRDOCDA,"APV")),U,8)="A" D TVPAID W "."
  1.  Q
  1. ODOC ;EP;TO CALCULATE DISBURSEMENTS FOR ARMS DOCUMENTS FROM THE OPEN
  1.  ;DOCUMENT FILE
  1.  K ACRDTOT
  1.  N ACRDOCDA,ACRATOT,ACRDOC,ACRDTOT,ACROFYDA,ACRODDA,ACRITOT,ACRPTOT
  1.  S ACRDOCDA=0
  1.  F  S ACRDOCDA=$O(^ACRDOC(ACRDOCDA)) Q:'ACRDOCDA  D
  1.  .Q:$P(^ACRDOC(ACRDOCDA,0),U,15)
  1.  .S ACRDOC=$S($P(^ACRDOC(ACRDOCDA,0),U,2)]"":$P(^(0),U,2),1:$P(^(0),U))
  1.  .I ACRDOC["-" S ACRDOC=$TR(ACRDOC,"-",""),ACRDOC=$E(ACRDOC,2,11)
  1.  .Q:ACRDOC=""
  1.  .D O1
  1.  .D O2
  1.  .D O3
  1.  .I ACRDTOT,ACRDTOT'=ACRITOT D
  1.  ..W "." ;!,ACRDOC,?15,$J($FN(ACRDTOT,"P,",2),12),?30,$J($FN(ACRATOT,"P,",2),12),?45,$J($FN(ACRITOT,"P,",2),12),?60,$J($FN(ACRPTOT,"P,",2),12)
  1.  ..I $P(^ACROBL(ACRDOCDA,"APV"),U,6)=1,$P(^("DT"),U,2)'=ACRATOT S $P(^("DT"),U,2)=$S(ACRDTOT>ACRATOT:ACRDTOT,1:ACRATOT)
  1.  Q
  1. O1 N ACROFYDA,X
  1.  S (ACROFYDA,ACRDTOT)=0
  1.  F  S ACROFYDA=$O(^AFSLODOC("DOCNO",ACRDOC,ACROFYDA)) Q:'ACROFYDA  D
  1.  .N ACRODDA
  1.  .S ACRODDA=0
  1.  .F  S ACRODDA=$O(^AFSLODOC("DOCNO",ACRDOC,ACROFYDA,ACRODDA)) Q:'ACRODDA  D
  1.  ..S X=$P($G(^AFSLODOC(ACROFYDA,1,ACRODDA,4)),U,4)
  1.  ..S:$E(X)="+" X=+$E(X,2,99)
  1.  ..S X=+X
  1.  ..S:X ACRDTOT=ACRDTOT+X
  1.  S:ACRDTOT ACRDTOT=ACRDTOT/100
  1.  Q
  1. O2 N X
  1.  S (X,ACRITOT,ACRPTOT)=0
  1.  F  S X=$O(^ACRSS("J",ACRDOCDA,X)) Q:'X  S ACRITOT=ACRITOT+$P($G(^ACRSS(X,"DT")),U,4),ACRPTOT=ACRPTOT+$P($G(^("DT")),U,21)
  1.  N Z
  1.  S Z=0
  1.  F  S Z=$O(^ACRDOC("MOD",ACRDOCDA,Z)) Q:'Z  D O21
  1.  Q
  1. O21 S X=0
  1.  F  S X=$O(^ACRSS("J",Z,X)) Q:'X  S ACRITOT=ACRITOT+$P($G(^ACRSS(X,"DT")),U,4),ACRPTOT=ACRPTOT+$P($G(^("DT")),U,21)
  1.  Q
  1. O3 N X,Y,Z
  1.  S (X,ACRATOT)=0
  1.  F  S X=$O(^AFSLAFP("N",ACRDOC,X)) Q:'X  D
  1.  .S Y=0
  1.  .F  S Y=$O(^AFSLAFP("N",ACRDOC,X,Y)) Q:'Y  D
  1.  ..S Z=0
  1.  ..F  S Z=$O(^AFSLAFP("N",ACRDOC,X,Y,Z)) Q:'Z  S ACRATOT=ACRATOT+$P($G(^AFSLAFP(X,1,Y,1,Z,0)),U,11)-$P($G(^(0)),U,12)+$P($G(^(1)),U,6)
  1.  Q
  1. MODS ;EP; SYNC ARMS PO MODS
  1.  N ACRDOCX,ACRDOCDA,ACRITOT,ACRRRDA
  1.  S ACRDOCX=0
  1.  F  S ACRDOCX=$O(^ACRDOC("MOD",ACRDOCX)) Q:'ACRDOCX  D
  1.  .S (ACRDOCDA,ACRITOT)=0
  1.  .F  S ACRDOCDA=$O(^ACRDOC("MOD",ACRDOCX,ACRDOCDA)) Q:'ACRDOCDA  D
  1.  ..S ACRRRDA=0
  1.  ..F  S ACRRRDA=$O(^ACRRR("C",ACRDOCDA,ACRRRDA)) Q:'ACRRRDA  D
  1.  ...Q:'$P(^ACRRR(ACRRRDA,0),U,11)&'$P(^("DT"),U,5)  S X=^("DT")
  1.  ...S ACRITOT=ACRITOT+($P(X,U,5)*$P(X,U,6))
  1.  ...S ACRDOC=$S($P(^ACRDOC(ACRDOCDA,0),U,2)]"":$P(^(0),U,2),1:$P(^(0),U))
  1.  ...I ACRDOC["-" S ACRDOC=$TR(ACRDOC,"-",""),ACRDOC=$E(ACRDOC,2,11)
  1.  ...S X=0
  1.  ...F  S X=$O(^AFSLAFP("N",ACRDOC,X)) Q:'X  D
  1.  ....S Y=0
  1.  ....F  S Y=$O(^AFSLAFP("N",ACRDOC,X,Y)) Q:'Y  D
  1.  .....S Z=0
  1.  .....F  S Z=$O(^AFSLAFP("N",ACRDOC,X,Y,Z)) Q:'Z  I $P(^AFSLAFP(X,1,Y,1,Z,0),U,11)=ACRITOT W !,ACRDOC,?15,ACRDOCDA
  1.  Q