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

ACRFTV1.m

Go to the documentation of this file. 
  1. ACRFTV1 ;IHS/OIRM/DSD/THL,AEF - TRAVEL REPORT -CON'T;  [ 09/262005  2:53 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,19**;NOV 05, 2001
  1.  ;;CONTINUATION OF ACRFTV
  1. DISPLAY ;EP;TO SETUP TO DISPLAY PAGE AND COLUMN HEADER
  1.  ;I "^CAN^TDEPT^PO^"'[(U_ACRTVT_U),"NDC"'[$E(ACRTVT) D  ;ACR*2.1*19.05 IM16848 -NOT NEEDED
  1.  I "GFH"'[$E(ACRTVT) S (ACRFY,ACRALWDA,ACRSSADA,ACRSSA)=""
  1.  I "GFH"[$E(ACRTVT) D
  1.  . I ACRTVT="G" D   ;ACR*2.1*3.24
  1.  . . S ACRDEPT=$P($G(^ACRALC(ACRZDA,0)),U,12) ;ACR*2.1*3.24
  1.  . . S ACRDT=$G(^ACRALC(ACRZDA,"DT")) ;ACR*2.1*3.24
  1.  . I ACRTVT="F" D   ;ACR*2.1*3.24
  1.  . . S ACRDEPT=$P($G(^ACRLOCB(ACRZDA,0)),U,5) ;ACR*2.1*3.24
  1.  . . S ACRDT=$G(^ACRLOCB(ACRZDA,"DT")) ;ACR*2.1*3.24
  1.  . I ACRTVT="H" D   ;ACR*2.1*3.24
  1.  . . S ACRDEPT=$P($G(^ACRALW(ACRZDA,0)),U,12) ;ACR*2.1*3.24
  1.  . . S ACRDT=$G(^ACRALW(ACRZDA,"DT")) ;ACR*2.1*3.24
  1.  ;S:ACRTVT="D" ACRDEPT=$P(^VA(200,ACRTVDA,0),U)  ;ACR*2.1*19.02 IM16848
  1.  S:ACRTVT="D" ACRDEPT=$$NAME2^ACRFUTL1(ACRTVDA)  ;ACR*2.1*19.02 IM16848
  1.  S:ACRTVT="TDEPT"!(ACRTVT="PO") ACRDEPT=ACRZDA
  1.  S:ACRTVT="C" ACRDEPT=ACRDPTDA
  1.  S:"^LOC^RC^AE^"[(U_ACRTVT_U) ACRDEPT="NOT SPECIFIED"
  1.  Q
  1. H1 ;EP;TO PRINT PAGE HEADER
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  I $E(IOST,1,2)="C-" W @IOF
  1.  W !,"TRAVEL REPORT"
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  W ?40,"DATE: ",Y
  1.  S ACRPAGE=$G(ACRPAGE)+1
  1.  W ?60,"PAGE: ",ACRPAGE
  1.  I ACRTVT="CAN"!$D(ACRCANDA) D
  1.  .S:ACRTVT="CAN" ACRCANDA=ACRZDA
  1.  .W !!,"Report for CAN:  ",$P(^AUTTCAN(ACRCANDA,0),U)
  1.  I ACRTVT'="CAN","ND"'[$E(ACRTVT) D
  1.  .W !,"-----------------------"
  1.  .W ?40,"----------------"
  1.  .W ?60,"-------"
  1.  .I $G(ACRSSA)]""&$G(ACRALWDA) D   ;ACR*2.1*3.24
  1.  ..W !,"SUB-SUB ACT: ",ACRSSA
  1.  ..W ?50,"ALLOWANCE: ",$P(^AUTTALLW(ACRALWDA,0),U)
  1.  .I ACRTVT'="PO" W !,"DEPARTMENT.: ",$S(ACRTVT="F"!(ACRTVT="TDEPT")!(ACRTVT="C"):$P(^AUTTPRG(ACRDEPT,0),U)_" ("_ACRDEPT_")",1:ACRDEPT)
  1.  .I ACRTVT="PO" W !,"PURCHASING OFFICE: ",$P(^DIC(4,+$G(^ACRPO(ACRDEPT,0)),0),U)," (",ACRDEPT,")"
  1.  .W:$G(ACRFY)]"" ?50,"FY.......: ",$G(ACRFY) ;ACR*2.1*3.24 
  1.  I ACRTVT="RC" D
  1.  .W !!,"TRAVEL ORDERS WITH RENTAL VEHICLE"
  1.  .W !
  1.  I ACRTVT="LOC" D
  1.  .W !!,"TRAVEL ORDERS TO SELECTED LOCATION: ",$P($G(^ACRPD(+$G(ACRLOC),0)),U)
  1.  .W !
  1.  I ACRTVT="AE" W !!,"TRAVEL ORDERS WHERE ACTUAL EXPENSES CLAIMED"
  1.  I ACRTVT="NCC" W !!,"TRAVEL ORDERS ON WHICH A NON-CONTRACT CARRIER WAS USED"
  1.  I ACRTVT="D" D
  1.  .W !!
  1.  .W:'$D(ACRDTAIL) "SUMMARY FOR "
  1.  .W "TRAVELER: ",ACRDEPT
  1.  S Y=ACRBEGIN
  1.  X ^DD("DD")
  1.  W !,"FOR TRAVEL BETWEEN..: ",Y
  1.  S Y=ACREND
  1.  X ^DD("DD")
  1.  W "  AND: ",Y
  1. H11 W:$D(ACRDTAIL) $$DASH^ACRFMENU
  1.  Q
  1. H2 W !,"------"
  1.  W ?25,"---------------"
  1.  W ?42,"---------------"
  1.  W ?59,"---------------"
  1.  W !?27,"OBLIGATIONS"
  1.  W ?46,"PENDING"
  1.  W !?29,"TO DATE"
  1.  W ?44,"OBLIGATIONS"
  1. H3 W !,"------"
  1.  W ?25,"---------------"
  1.  W ?42,"---------------"
  1.  W ?59,"---------------"
  1.  Q
  1. CAN ;EP;TO SELECT CAN FOR TV
  1.  S DIC="^AUTTCAN("
  1.  S DIC(0)="AEMQ"
  1.  S DIC("A")="Which CAN NO.: "
  1.  W !
  1.  D DIC^ACRFDIC
  1.  I +Y<1 S ACRQUIT="" Q
  1.  S ACRZDA=+Y
  1.  S DIR(0)="FOA^4:4"
  1.  S DIR("A")="Fiscal Year..: "
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I Y'?4N S ACRQUIT="" Q
  1.  S ACRFY=Y
  1.  Q
  1. DEPT ;EP;TO SELECT DEPARTMENT
  1.  I ACRTVT="TDEPT" D
  1.  .S DIC="^AUTTPRG("
  1.  .S DIC(0)="AEMQ"
  1.  .S DIC("A")="Which DEPARTMENT/PROGRAM: "
  1.  I ACRTVT="PO" D
  1.  .S DIC="^ACRPO("
  1.  .S DIC(0)="AEMQ"
  1.  .S DIC("A")="Which PURCHASING OFFICE: "
  1.  W !
  1.  D DIC^ACRFDIC
  1.  I +Y<1 S ACRQUIT="" Q
  1.  S ACRZDA=+Y
  1.  Q
  1. C1 ;EP;
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Print report for a specific CAN"
  1.  S DIR("B")="NO"
  1.  K ACRCANDA
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  I ACRY=1 D
  1.  .S ACRZZDA=ACRZDA
  1.  .D CAN
  1.  .Q:$D(ACRQUIT)!$D(ACROUT)
  1.  .S ACRCANDA=ACRZDA
  1.  .S ACRZDA=ACRZZDA
  1.  .K ACRZZDA
  1.  Q
  1. PDEPT ;EP;
  1.  K ^TMP("ACRTV",$J)
  1.  S ACRXREF=ACRTVT
  1.  S ACRDPTDA=ACRZDA
  1.  S ACRZDA=0
  1.  S (ACRREQ,ACROBL,ACRSPT)=0
  1.  F  S ACRZDA=$O(^ACRDOC(ACRXREF,ACRDPTDA,ACRZDA)) Q:'ACRZDA  D
  1.  .Q:'$D(^ACRDOC(ACRZDA,"TO"))
  1.  .S ACRTO=^ACRDOC(ACRZDA,"TO")
  1.  .S ACRFR=$P(ACRTO,U,14)
  1.  .S ACRTO=$P(ACRTO,U,15)
  1.  .I ACRFR>(ACRBEGIN-1),ACRTO<(ACREND+1) D
  1.  ..I $D(ACRINCMP) D  I $D(ACRQUIT) K ACRQUIT Q
  1.  ...S ACRDOCDA=ACRZDA
  1.  ...D INCOMP^ACRFTV3
  1.  ..S:'$D(ACRTVTX) ACRTVTX=ACRTVT
  1.  ..S ACRTVT="C"
  1.  ..I $D(ACRBOTH) N ACRDTAIL S ACRDTAIL=""
  1.  ..D SS4^ACRFTV3
  1.  S ACRZDA=ACRDPTDA
  1.  S ACRTVT=$S($G(ACRTVTX)]"":ACRTVTX,1:"TDEPT")
  1.  K ACRZZDA,ACRTVTX
  1.  D SS1^ACRFTV2
  1.  D PAUSE^ACRFWARN
  1.  W:$D(ACRDTAIL) @IOF
  1.  Q
  1. SS2 ;EP;TO PRINT DETAILED LISTING OF EACH TRAVEL ORDER
  1.  D H1,SS3
  1.  S ACROBJ=$S($G(ACRDTL1):"",1:"ALL")
  1.  S ACRX=""
  1.  F  S ACRX=$O(^TMP("ACRTV",$J,ACR,ACRX)) Q:ACRX=""!$D(ACRQUIT)!$D(ACROUT)  S ACR0=^(ACRX) D
  1.  .I ACR'="ALL",ACROBJ'="ALL",ACROBJ'=ACR D
  1.  ..S ACROBJ=ACR
  1.  ..W !?10,"Object Code: ",ACROBJ
  1.  .F ACRI=1:1:6,11:1:14,21 S @("ACR"_ACRI)=$P(ACR0,U,ACRI)
  1.  .W !,$E(ACR1,4,7),$E(ACR1,2,3)
  1.  .W ?7,ACR2
  1.  .W ?22,ACR3
  1.  .W ?50,$J($FN(ACR5,"P,",2),15)
  1.  .W ?64,$J($FN(ACR6,"P,",2),15)
  1.  .I ION>80 W ?80,$J($FN(ACR21,"P,",2),15)
  1.  .W !,$E(ACR11,4,7),$E(ACR11,2,3)
  1.  .W ?7,$S(ACRTVT="D":ACR14,1:$P(ACR0,U,10))
  1.  .;I ACR13,ACRTVT'="D" W ?22,$E($P(^VA(200,ACR13,0),U),1,28)  ;ACR*2.1*19.02 IM16848
  1.  .I ACR13,ACRTVT'="D" W ?22,$E($$NAME2^ACRFUTL1(ACR13),1,28)  ;ACR*2.1*19.02 IM16848
  1.  .I ACR12]"",ACRTVT="D" W ?22,$E(ACR12,1,28)
  1.  .I ION<81 W ?65,$J($FN(ACR21,"P,",2),15)
  1.  .I $D(^TMP("ACRTV",$J,ACR,ACRX,"SIGS")) S ACRSIGS=^("SIGS") D SIGS
  1.  .K ACRSIGS
  1.  .I $Y>(IOSL-5) D PAUSE^ACRFWARN W @IOF D:'$D(ACRQUIT) H1,SS3
  1.  Q
  1. SS3 ;EP;TO PRINT COLUMN LABELS
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  I $D(ACRDTAIL) D
  1.  .W !,"BEGIN"
  1.  .W:ION<81 ?68,"OBLIGATED"
  1.  .W !,"END"
  1.  .W ?7,"DOCUMENT NO."
  1.  .W ?22,"PURPOSE OF TRAVEL/",$S(ACRTVT'="D":"TRAVELER",1:"DESTINATION")
  1.  .W ?53,"REQUESTED"
  1.  I '$D(ACRDTAIL) D
  1.  .W !
  1.  .W:ION<81 ?68,"OBLIGATED"
  1.  .W !?53,"REQUESTED"
  1.  I ION>80 D
  1.  .W ?68,"OBLIGATED"
  1.  .W ?84,"SPENT"
  1.  W:ION<81 ?68,"SPENT"
  1.  W $$DASH^ACRFMENU
  1.  Q
  1. SIGS ;CHECK EACH DOCUMENT IF ONLY INCOMPLETE TV'S ARE BEING REPORTED
  1.  S ACRY=$P(ACR0,U,11)
  1.  F ACRI=1:1:6 S ACRD=$P($P(ACRSIGS,U,ACRI),".") D DD
  1.  S ACRSIGS=""
  1.  W $$DASH^ACRFMENU
  1.  Q
  1. DD W:ACRI=1 !?7,"TO TRAVELER..: "
  1.  W:ACRI=2 !?7,"TRAVELER SIG.: "
  1.  I ACRD]"" D
  1.  .W:ACRI=3 !?7,"RECOMMEND SIG: "
  1.  .W:ACRI=4 !?7,"APPROVER SIG.: "
  1.  W:ACRI=5 !?7,"AUDITOR SIG..: "
  1.  W:ACRI=6 !?7,"CERTIFIER SIG: "
  1.  S:'$D(ACRSIGT(ACRI)) ACRSIGT(ACRI)=0
  1.  Q:ACRD=""
  1.  W $E(ACRD,4,5),"-",$E(ACRD,6,7),"-",$E(ACRD,2,3)
  1.  S X1=ACRD,X2=ACRY
  1.  D ^%DTC
  1.  W " (",$J(X,2),")"
  1.  S ACRY=ACRD
  1.  S $P(ACRSIGT(ACRI),U)=$P(ACRSIGT(ACRI),U)+1
  1.  S $P(ACRSIGT(ACRI),U,2)=$P(ACRSIGT(ACRI),U,2)+X
  1.  Q