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

ACRFPAYE.m

Go to the documentation of this file. 
  1. ACRFPAYE ;IHS/OIRM/DSD/THL,AEF - MISC PM REPORTS;  [ 01/03/2003  9:52 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5**;NOV 05, 2001
  1.  ;;
  1. EFTRPT ;EP;TO PRINT ELECTRONIC FUNDS TRANSFER PROFILE
  1.  F  D EFT1 Q:$D(ACRQUIT)!$D(ACROUT)
  1. EFTEXIT K ACRQUIT,ACROUT
  1.  K ^TMP("ACREFTR",$J)
  1.  Q
  1. EFT1 ;
  1.  N ACRBEGIN,ACREND,ACRDATE
  1.  K ^TMP("ACREFTR",$J)
  1.  W @IOF
  1.  W !?10,"Select beginning and ending dates for the"
  1.  W !?10,"ELECTRONIC FUNDS TRANSFER TO TREASURY PROFILE"
  1.  W !
  1.  D ^ACRFDATE
  1.  I '$G(ACRBEGIN)!'$G(ACREND) S ACRQUIT="" Q
  1.  S (ACRRTN,ZTRTN)="EFT2^ACRFPAYE"
  1.  S ZTDESC="ELECTRONIC FUNDS TRANSFER TO TREASURY PROFILE"
  1.  D ^ACRFZIS
  1.  Q
  1. EFT2 ;EP;TO PRINT ELECTRONIC FUNDS TRANSFER PROFILE
  1.  D EFTHEAD
  1.  N ACROBJ,ACR0,ACRBAT,ACRVT,ACRREF,ACRREF2,ACRF,ACRF,ACRV,ACRB
  1.  N ACRFYDA,ACRBATDA,ACRSEQDA,ACRX,ACRXM,ACRP
  1.  S ACRDATE=ACRBEGIN-1
  1.  S ACRF="ACREFTR"
  1.  F  S ACRDATE=$O(^AFSLAFP("EXP",ACRDATE)) Q:'ACRDATE!(ACRDATE>ACREND)  D
  1.  .S ACRFYDA=0
  1.  .F  S ACRFYDA=$O(^AFSLAFP("EXP",ACRDATE,ACRFYDA)) Q:'ACRFYDA  D
  1.  ..S ACRBATDA=0
  1.  ..F  S ACRBATDA=$O(^AFSLAFP("EXP",ACRDATE,ACRFYDA,ACRBATDA)) Q:'ACRBATDA  D
  1.  ...S ACR0=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
  1.  ...Q:ACR0=""
  1.  ...S ACRBAT=$$BATCH^ACRFPAYE(ACRFYDA,ACRBATDA)  ; Batch Type
  1.  ...Q:ACRBAT=""
  1.  ...Q:ACRBAT="G"
  1.  ...S ACRVT=$P(ACR0,U,4)              ; Vendor or Travel
  1.  ...Q:ACRVT=""
  1.  ...I ACRVT="T" D
  1.  ....S ACRBAT=$S(ACRBAT="A":"D",ACRBAT="B":"E",ACRBAT="C":"F",ACRBAT="N":"O",1:ACRBAT)
  1.  ...S ACRSEQDA=0
  1.  ...F  S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA  D
  1.  ....S ACRVT=$P(ACR0,U,4)              ; Vendor or Travel
  1.  ....S ACRX=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
  1.  ....S ACROBJ=$P(ACRX,U,8)
  1.  ....Q:ACROBJ=""
  1.  ....S ACROBJ=$P(^AUTTOBJC(ACROBJ,0),U)
  1.  ....Q:ACROBJ=""
  1.  ....S ACRREF=$P(ACRX,U,5)
  1.  ....S ACRREF2=$P(ACRX,U,6)
  1.  ....S ACRP=$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA) ;NET TO TREASURY
  1.  ....S ACRVT=$$BAT(ACRVT,ACRREF,ACRREF2,ACROBJ)
  1.  ....I ACRREF=326 D  Q                    ;COUNT CONTRACTS
  1.  .....I $E(ACROBJ,1,3)=418!(ACROBJ>2581&(ACROBJ<2586)) D  Q
  1.  ......D CNT(ACRF,"I",ACRBAT,ACRP) Q  ; Tribal
  1.  .....D CNT(ACRF,"X",ACRBAT,ACRP)
  1.  ....D CNT(ACRF,ACRVT,ACRBAT,ACRP)
  1.  ;
  1.  N A,B,C,D,E,F,G,STR,STR1,STR2,CNT
  1.  F A="V","X","VTOT","T","AIR","TTOT","I","ITOT","TOT" D
  1.  .I A["TOT" D  Q
  1.  ..S STR=$G(^TMP(ACRF,$J,A,"TOT"))
  1.  ..S (B1,B2)=" "
  1.  ..S STR1=$G(^TMP(ACRF,$J,A,"ACH"))
  1.  ..S STR2=$G(^TMP(ACRF,$J,A,"CHK"))
  1.  ..D WRITE(A,B1,STR1,B2,STR2,STR,.CNT)
  1.  .S G="" K CNT F  S G=$O(^TMP(ACRF,$J,A,G)) Q:G=""  D
  1.  ..S STR=$G(^TMP(ACRF,$J,A,G))
  1.  ..S B1=$E(G,1),B2=$E(G,2)
  1.  ..S STR1=$G(^TMP(ACRF,$J,A,G,B1))
  1.  ..S STR2=$G(^TMP(ACRF,$J,A,G,B2))
  1.  ..D WRITE(A,B1,STR1,B2,STR2,STR,.CNT)
  1.  W $$DASH^ACRFMENU
  1.  D PAUSE^ACRFWARN
  1.  Q
  1. WRITE(A,B,C,D,E,F,CNT) ;LOCAL ENTRY TO WRITE PROFILE
  1.  N T
  1.  D TITLE(A,.CNT,.T)
  1.  N C1,C2,E1,E2
  1.  S C1=$P(C,U)
  1.  S C2=$P(C,U,2)
  1.  S E1=$P(E,U)
  1.  S E2=$P(E,U,2)
  1.  S F1=$P(F,U)
  1.  S F2=$P(F,U,2)
  1.  I A["TOT" D  W !
  1.  .I A'="TOT" D
  1.  ..W !,?13,"|-----",?19,"|---------------",?35,"|-----"
  1.  ..W ?41,"|---------------",?57,"|-----",?63,"|----------------"
  1.  .W !?13 F J=1:1:67 W "_"
  1.  W !,T,?13,"|"_B,$J(C1,4),?19,"|",$J($FN(C2,"P,",2),15)
  1.  W ?35,"|"_D,$J(E1,4),?41,"|",$J($FN(E2,"P,",2),15)
  1.  W ?57,"|",$J(F1,5),"|"
  1.  W ?63,$J($FN(F2,"P,",2),16)
  1.  Q
  1. TITLE(A,CNT,T)       ;LOCAL ENTRY
  1.  ; RETURNS TITLE
  1.  S T=""
  1.  I A="V",'$G(CNT) S T="VENDOR" W ! S CNT=1
  1.  I A="T",'$G(CNT) S T="TRAVEL" W !,$$DASH^ACRFMENU,! S CNT=1
  1.  I A="I",'$G(CNT) S T="TRIBAL" W !,$$DASH^ACRFMENU,! S CNT=1
  1.  I A="X",'$G(CNT) S T=" CONTRACT" D WRT(.CNT)
  1.  I A="AIR",'$G(CNT) S T=" AIRLINE" D WRT(.CNT)
  1.  I A="VTOT" S T=" VENDOR TOTAL"
  1.  I A="TTOT" S T=" TRAVEL TOTAL"
  1.  I A="ITOT" S T=" TRIBAL TOTAL"
  1.  I A="TOT" S T="GRAND TOTAL",CNT=1
  1.  Q
  1. WRT(CNT) ;LOCAL ENTRY
  1.  S CNT=1
  1.  W !,?13,"|-----",?19,"|---------------",?35,"|-----"
  1.  W ?41,"|---------------",?57,"|-----",?63,"|----------------"
  1.  W !
  1.  Q
  1. EFTHEAD ;
  1.  W @IOF
  1.  W !?10,"INDIAN HEALTH SERVICE"
  1.  W !?10,$P($G(^AUTTAREA(+$G(^ACRSYS(1,0)),0)),U)," AREA OFFICE"
  1.  W !!?10,"ELECTRONIC FUNDS TRANSFER TO TREASURY PROFILE"
  1.  W !?10,"REPORT DATE: "
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  W Y
  1.  W !?10,"REPORT FROM: "
  1.  S Y=ACRBEGIN
  1.  X ^DD("DD")
  1.  W Y
  1.  W !?10,"REPORT TO..: "
  1.  S Y=ACREND
  1.  X ^DD("DD")
  1.  W Y
  1.  W $$DASH^ACRFMENU
  1.  W !!,?13,"|    EFT",?35,"|    NON-EFT",?57,"|TOTAL",?63,"|  TOTAL"
  1.  W !,"PAYMENT TYPE",?13,"| NO. ",?19,"|  DOLLARS",?35,"| NO. "
  1.  W ?41,"|  DOLLARS",?57,"| NO. ",?63,"|  DOLLARS"
  1.  W $$DASH^ACRFMENU
  1.  Q
  1. CNT(F,V,B,P) ;LOCAL ENTRY - COUNT NON-CHECKS
  1.  ;
  1.  N T,G
  1.  S T="UNKNOWN"_ACRX
  1.  I "ABDE"[B S T="ACH"
  1.  I "CFNO"[B S T="CHK"
  1.  S G=$$GRP(B)
  1.  I G="UNKNOWN" S ^TMP(F,$J,"ERROR",X)="" Q
  1.  ;
  1.  S $P(^TMP(F,$J,V,G,B),U)=$P($G(^TMP(F,$J,V,G,B)),U)+1
  1.  S $P(^TMP(F,$J,V,G,B),U,2)=$P($G(^TMP(F,$J,V,G,B)),U,2)+P
  1.  S $P(^TMP(F,$J,V,G),U)=$P($G(^TMP(F,$J,V,G)),U)+1
  1.  S $P(^TMP(F,$J,V,G),U,2)=$P($G(^TMP(F,$J,V,G)),U,2)+P
  1.  ;
  1.  ;SUB AND GRAND TOTALS
  1.  S $P(^TMP(F,$J,"TOT",T),U)=$P($G(^TMP(F,$J,"TOT",T)),U)+1
  1.  S $P(^TMP(F,$J,"TOT",T),U,2)=$P($G(^TMP(F,$J,"TOT",T)),U,2)+P
  1.  S $P(^TMP(F,$J,"TOT","TOT"),U)=$P($G(^TMP(F,$J,"TOT","TOT")),U)+1
  1.  S $P(^TMP(F,$J,"TOT","TOT"),U,2)=$P($G(^TMP(F,$J,"TOT","TOT")),U,2)+P
  1.  I V["X"!(V["AIR") D
  1.  .S:V["X" V="V"
  1.  .S:V["AIR" V="T"
  1.  S $P(^TMP(F,$J,V_"TOT",T),U)=$P($G(^TMP(F,$J,V_"TOT",T)),U)+1
  1.  S $P(^TMP(F,$J,V_"TOT",T),U,2)=$P($G(^TMP(F,$J,V_"TOT",T)),U,2)+P
  1.  S $P(^TMP(F,$J,V_"TOT","TOT"),U)=$P($G(^TMP(F,$J,V_"TOT","TOT")),U)+1
  1.  S $P(^TMP(F,$J,V_"TOT","TOT"),U,2)=$P($G(^TMP(F,$J,V_"TOT","TOT")),U,2)+P
  1.  Q
  1. BAT(VT,ACRR,ACRR2,ACRO)      ;LOCAL EXTRINSIC FUNCTION
  1.  ; ENTERS WITH REFERENCE CODES
  1.  ;CHANGES VENDOR TO TRAVEL IF AIRLINE PAYMENT
  1.  ;
  1.  I VT="V",ACRR=130,$E(ACRO,1,3)=221!($E(ACRO,1,3)=121) Q "T"
  1.  I ACRR=602!(ACRR2=602) Q "T"  ; TRAVEL ADVANCE
  1.  I ACRO="219M"!(ACRR=618) Q "AIR"
  1.  I VT="V",ACRR=130 Q "AIR"
  1.  I ACRR'=618,ACRR2'=618 Q VT  ; NOT AIRLINE
  1.  Q "AIR"  ; AIRLINE, CHANGE TO TRAVEL
  1.  ;
  1. GRP(B)          ;LOCAL FORENSIC FUNCTION
  1.  ;ENTERS WITH BATCH PREFIX
  1.  ;RETURN GROUP DESIGNATION
  1.  I "AC"[B Q "AC"
  1.  I "BN"[B Q "BN"
  1.  I "DF"[B Q "DF"
  1.  I "EO"[B Q "EO"
  1.  Q B
  1.  ;
  1. BATCH(ACRFYDA,ACRBATDA)      ;LOCAL ENTRY; EXTRINSIC FUNCTION
  1.  ;              Enters with EIN for 1166 Approvals for Payment file
  1.  ;              Returns Batch type
  1.  N ACRTMP,ACRBAT
  1.  S ACRTMP=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
  1.  S ACRBAT=$P(ACRTMP,U,8)
  1.  Q ACRBAT