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

ACRFEXP3.m

Go to the documentation of this file. 
  1. ACRFEXP3 ;IHS/OIRM/DSD/AEF - EXPORT TO DHR FILE [ 10/4/2005  3:57 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16,19**;NOV 05, 2001
  1.  ;
  1.  ;
  1.  ;This routine processes payments from the 1166 Approvals
  1.  ;for Payment file and places them into the DHR Data Records
  1.  ;file for further processing and subsequent transmission to
  1.  ;CORE.
  1.  ;
  1.  ;It is expected that the global ^TMP("ACR",$J,"DHR") would have
  1.  ;been built by routine ^ACRFEXP2 and will contain the payments
  1.  ;to be placed into the DHR Data Records file.
  1.  ;
  1. DHR ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  Q:'$P($G(^ACRSYS(1,"DT1")),U,9)
  1.  ;
  1.  Q:'$D(^TMP("ACR",$J,"DHR"))
  1.  ;
  1.  D LOOP
  1.  ;
  1.  Q
  1. LOOP ;----- LOOP THROUGH ^TMP("ACR",$J,"DHR") GLOBAL AND PUT
  1.  ;      PAYMENT DATA INTO DHR DATA RECORDS FILE
  1.  ;
  1.  N ACRD0,ACRD1,ACRD2,ACRPMT,ACRVEND
  1.  S ACRVEND=""
  1.  F  S ACRVEND=$O(^TMP("ACR",$J,"DHR",ACRVEND)) Q:ACRVEND']""  D
  1.  . S ACRPMT=0
  1.  . F  S ACRPMT=$O(^TMP("ACR",$J,"DHR",ACRVEND,ACRPMT)) Q:'ACRPMT  D
  1.  . . S ACRDATA=^TMP("ACR",$J,"DHR",ACRVEND,ACRPMT,0)
  1.  . . S ACRD0=$P(ACRDATA,U,3)
  1.  . . S ACRD1=$P(ACRDATA,U,4)
  1.  . . S ACRD2=$P(ACRDATA,U,5)
  1.  . . D ONE(ACRD0,ACRD1,ACRD2)
  1.  Q
  1. ONE(ACRD0,ACRD1,ACRD2)       ;
  1.  ;----- PROCESS ONE PAYMENT
  1.  ;
  1.  ;      INPUT:
  1.  ;      ACRD0  = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
  1.  ;      ACRD1  = BATCH IEN
  1.  ;      ACRD2  = SEQ IEN
  1.  ;
  1.  N ACRDATA,ACROCC,Z
  1.  ;Q:$P($G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,"ARMS")),U,2)  ;ACR*2.1*16.06 IM15505
  1.  S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,"ARMS"))  ;ACR*2.1*16.06 IM15505
  1.  Q:$P(ACRDATA,U,2)                               ;ACR*2.1*16.06 IM15505
  1.  S ACRDOCDA=$P(ACRDATA,U)                        ;ACR*2.1*16.06 IM15505
  1.  S ACRDOC0=""                                    ;ACR*2.1*16.06 IM15505
  1.  S:ACRDOCDA]"" ACRDOC0=$G(^ACRDOC(ACRDOCDA,0))   ;ACR*2.1*16.06 IM15505
  1.  D SET(ACRD0,ACRD1,ACRD2,.Z)
  1.  S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))  ;ACR*2.1*16.06 IM15505
  1.  S ACRIV="PAY"
  1.  S:$P(ACRDATA,U,18)="05025" ACRIV=""     ;DISCOUNT;ACR*2.1*16.06 IM15505
  1.  ;D DHRRCD(Z)                                         ;ACR*2.1*16.06 IM15505
  1.  D DHRRCD(Z,ACRIV)                                    ;ACR*2.1*16.06 IM15505
  1.  ;S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))     ;ACR*2.1*16.06 IM15505 
  1.  I +$P(ACRDATA,U,12),$P(ACRDATA,U,24) D
  1.  . Q:$P(ACRDATA,U,18)="06119"
  1.  . S ACROCC=$P(ACRDATA,U,8)
  1.  . I ACROCC S ACROCC=$P($G(^AUTTOBJC(ACROCC,0)),U)
  1.  . Q:ACROCC="219M"
  1.  . Q:$P(ACRDATA,U,6)'=600
  1.  . ;D LTA(ACRD0,ACRD1,ACRD2,.Z)                     ;ACR*2.1*3.06
  1.  . N ACRDAT                                         ;ACR*2.1*3.06
  1.  . D LTA(ACRD0,ACRD1,ACRD2,.Z,.ACRDAT)              ;ACR*2.1*3.06
  1.  . D DHR2^ACRFPAY2(ACRD0,ACRD1,ACRD2,ACRDAT)        ;ACR*2.1*3.06
  1.  .;D DHRRCD(Z)                                   ;ACR*2.1*16.06 IM15505
  1.  . D DHRRCD(Z,"PAY")                             ;ACR*2.1*16.06 IM15505
  1.  D UPDATE(ACRD0,ACRD1,ACRD2)
  1.  Q
  1. SET(ACRD0,ACRD1,ACRD2,Z)     ;
  1.  ;----- SET DHR INFORMATION INTO VARIABLE Z
  1.  ;
  1.  ;      INPUT:
  1.  ;      ACRD0  = FY IEN OF 1166 APPROVALS FOR PAYMENT FILE
  1.  ;      ACRD1  = BATCH IEN OF 1166 APPROVALS FOR PAYMENT FILE
  1.  ;      ACRD2  = SEQUENCE IEN OF 1166 APPROVALS FOR PAYMENT FILE
  1.  ;
  1.  ;      RETURNS:
  1.  ;      Z      = DHR DATA STRING
  1.  ;
  1.  N ACRAMT,ACRBTYP,ACRCAN,ACROBJ,ACRSEQ0,ACRSEQ1,ACRSEQ3,ACRSSN
  1.  D ^XBKVAR
  1.  S ACRBTYP=$P($G(^AFSLAFP(ACRD0,1,ACRD1,0)),U,4)
  1.  S ACRSEQ0=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
  1.  S ACRSEQ1=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,1))
  1.  S ACRSEQ3=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,3))
  1.  S ACRCAN=$P(ACRSEQ0,U,7)
  1.  I ACRCAN S ACRCAN=$P($G(^AUTTCAN(ACRCAN,0)),U)
  1.  S ACROBJ=$P(ACRSEQ0,U,8)
  1.  I ACROBJ S ACROBJ=$P($G(^AUTTOBJC(ACROBJ,0)),U)
  1.  S ACRAMT=$P(ACRSEQ0,U,11)
  1.  S ACRAMT=$TR(ACRAMT,".","")
  1.  S ACRSSN=""
  1.  I ACRBTYP="V" D
  1.  . S ACRSSN=$P(ACRSEQ0,U,10)
  1.  . S ACRSSN=$P($G(^AUTTVNDR(ACRSSN,11)),U,13)
  1.  I ACRBTYP="T" D
  1.  . S ACRSSN=$P(ACRSEQ0,U,24)
  1.  . S ACRSSN=$P($G(^VA(200,ACRSSN,1)),U,9)
  1.  ;
  1.  S Z=""
  1.  S $E(Z)=2
  1.  S $E(Z,2,7)=$E(DT,4,7)_$E(DT,2,3)
  1.  S $E(Z,8,12)=$$PAD^ACRFUTL($P(ACRSEQ0,U,18),"R",5,"")
  1.  S $E(Z,13,15)=$$PAD^ACRFUTL($P(ACRSEQ0,U,5),"R",3,"")
  1.  S $E(Z,16,25)=$$PAD^ACRFUTL($P(ACRSEQ0,U,20),"R",10,"")
  1.  S $E(Z,26,28)=$$PAD^ACRFUTL($P(ACRSEQ0,U,6),"R",3,"")
  1.  S $E(Z,29,38)=$$PAD^ACRFUTL($P(ACRSEQ0,U,21),"R",10,"")
  1.  S $E(Z,39)=1
  1.  S $E(Z,40)=$$PAD^ACRFUTL($P(ACRSEQ0,U,2),"R",1,"")
  1.  S $E(Z,41,47)=$$PAD^ACRFUTL($G(ACRCAN),"R",7,"")
  1.  S $E(Z,48,51)=$$PAD^ACRFUTL($G(ACROBJ),"R",4,"")
  1.  S $E(Z,52,63)=$$PAD^ACRFUTL(ACRAMT,"L",12,0)
  1.  S $E(Z,64)=1
  1.  S $E(Z,65,79)=$$PAD^ACRFUTL($G(ACRSSN),"R",15,"")
  1.  S $E(Z,80,94)=$$PAD^ACRFUTL("","R",15,"")
  1.  S $E(Z,95,104)=$$PAD^ACRFUTL($P(ACRSEQ1,U,11),"R",10,"")
  1.  S $E(Z,105,106)=$$PAD^ACRFUTL("","R",2,"")
  1.  S $E(Z,107,108)=$$PAD^ACRFUTL("","R",2,"")
  1.  S $E(Z,109)=$$PAD^ACRFUTL("","R",1,"")
  1.  S $E(Z,110,111)=$$PAD^ACRFUTL("","R",2,"")
  1.  S $E(Z,112,115)=$$PAD^ACRFUTL("","R",4,"")
  1.  S $E(Z,116,119)=$$PAD^ACRFUTL("","R",4,"")
  1.  S $E(Z,120,125)=$$PAD^ACRFUTL("","R",6,"")
  1.  S $E(Z,126,129)=$$PAD^ACRFUTL($P(ACRSEQ3,U),"R",4,"")
  1.  S $E(Z,130,133)=$$PAD^ACRFUTL($P(ACRSEQ3,U,2),"R",4,"")
  1.  S $E(Z,134,135)=$$PAD^ACRFUTL($P(ACRSEQ3,U,3),"R",2,"")
  1.  S $E(Z,136)=$$PAD^ACRFUTL("","R",1,"")
  1.  S $E(Z,137,140)=$$PAD^ACRFUTL("","R",4,"")
  1.  S $E(Z,141,160)=$$PAD^ACRFUTL(0,"R",20,0)
  1.  Q
  1. LTA(ACRD0,ACRD1,ACRD2,Z,ACRDAT)     ; ACR*2.1*3.06
  1.  ;----- LIQUIDATE TRAVEL ADVANCE, SET LTA DHR DATA INTO VARIABLE Z
  1.  ;      IF PAYMENT IS FOR TRAVEL VOUCHER WITH TRAVEL ADVANCE AMOUNT,
  1.  ;      CREATE SECOND DHR TO LIQUIDATE THE TRAVEL ADVANCE
  1.  ;
  1.  ;      INPUT:
  1.  ;      ACRD0  = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
  1.  ;      ACRD1  = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
  1.  ;      ACRD2  = SEQUENCE IEN OF 1166 APPROVALS FOR PAYMENT FILE
  1.  ;      Z      = DHR DATA STRING FOR ORIGINAL DHR
  1.  ;      ACRDAT = NULL
  1.  ;
  1.  ;      RETURNS:
  1.  ;      Z      = DHR DATA STRING CONTAINING TRAVEL ADVANCE LIQUIDATION
  1.  ;      ACRDAT = MODIFIED STRING REPRESENTING THE ZERO NODE
  1.  ;
  1.  N ACRAMT,ACRNAME
  1.  S ACRDAT=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
  1.  S ACRAMT=$P(ACRDAT,U,12)
  1.  S ACRAMT=$$DOL^ACRFUTL(ACRAMT)
  1.  S ACRAMT=$TR(ACRAMT,".","")
  1.  S ACRNAME=$P(ACRDAT,U,24)
  1.  ;S ACRNAME=$P($G(^VA(200,ACRNAME,0)),U)        ;ACR*2.1*19.02 IM16848
  1.  ;S ACRNAME=$P(ACRNAME,",")_" "_$E($P(ACRNAME,",",2)) ;ACR*2.1*19.02 IM16848
  1.  S ACRNAME=$$NAME3^ACRFUTL1(ACRNAME)            ;ACR*2.1*19.02 IM16848
  1.  ;
  1.  S ($P(ACRDAT,U,18),$E(Z,8,12))="24219"
  1.  S ($P(ACRDAT,U,6),$E(Z,26,28))="602"
  1.  S ($P(ACRDAT,U,11),$E(Z,52,63))=$$PAD^ACRFUTL(ACRAMT,"L",12,0)
  1.  S $P(ACRDAT,U,12)=""
  1.  S ($P(ACRDAT,U,24),$E(Z,80,94))=$$PAD^ACRFUTL(ACRNAME,"R",15,"")
  1.  Q
  1. DHRRCD(Z,ACRIV)          ;                      ;ACR*2.1*16.06 IM15505
  1.  ;----- INTERFACE TO DHRRCD^ACRFDHR1 ROUTINE
  1.  ;      SETS UP VARIABLES NEEDED TO CALL DHRRCD^ACRFDHR1 ROUTINE
  1.  ;      TO PUT DHR RECORDS INTO DHR DATA RECORDS FILE
  1.  ;
  1.  ;      INPUT: 
  1.  ;      Z       = DHR DATA STRING
  1.  ;      ACRIV   = OBLIGATION/PAYMENT INDICATOR   ;ACR*2.1*16.06 IM15505
  1.  ;
  1.  ;      ACR3    = TRANSACTION CODE
  1.  ;      ACRACPT = ACCOUNTING POINT
  1.  ;      ACRDHR  = DHR DATA STRING
  1.  ;      ACRREF  = ORIGINAL DOCUMENT REFERENCE CODE
  1.  ;
  1.  ;N ACR3,ACRACPT,ACRDHR,ACRIV,ACRREF            ;ACR*2.1*16.06 IM15505
  1.  N ACR3,ACRACPT,ACRDHR,ACRREF                   ;ACR*2.1*16.06 IM15505
  1.  S ACR3=$E(Z,8,10)
  1.  S ACRACPT=$E(Z,42,43)
  1.  S ACRREF=$E(Z,13,15)
  1.  ;S ACRIV="PAY"                                  ;ACR*2.1*16.06 IM15505
  1.  S ACRDHR=$$UPPER^ACRFUTL(Z)
  1.  D DHRRCD^ACRFDHR1
  1.  Q
  1. UPDATE(ACRD0,ACRD1,ACRD2)    ;
  1.  ;----- UPDATE ARMS DHR FILED FIELD
  1.  ;
  1.  N DA,DIE,DR,X,Y
  1.  S DA(2)=ACRD0
  1.  S DA(1)=ACRD1
  1.  S DA=ACRD2
  1.  S DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
  1.  S DR=".03////1"
  1.  D ^DIE
  1.  Q