ACRFTV3 ;IHS/OIRM/DSD/THL,AEF - TRAVEL REPORT; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE TO PRINT TRAVEL REPORT
SS4 ;EP;
S (ACR,ACR4,ACR9,ACR21)=0
I ACRTVT'="D" S (ACRREQ,ACROBL,ACRSPT)=0
F S ACR=$O(^ACRSS(ACRTVT,ACRZDA,ACR)) Q:'ACR D
.Q:'$D(^ACRSS(ACR,0))!'$D(^ACRSS(ACR,"DT"))
.S ACR0=^ACRSS(ACR,0)
.S ACRDT=^ACRSS(ACR,"DT")
.D SS5
Q:ACRTVT="D"!(ACRTVT="TDEPT")!(ACRTVT="PO")!(ACRTVT="C")
I '$D(ACRQUIT),$D(^TMP("ACRTV",$J)) D SS1^ACRFTV2
I '$D(ACRQUIT),$E(IOST,1,2)="C-" D PAUSE^ACRFWARN
W @IOF
K ^TMP("ACRTV",$J)
Q
SS5 S ACRDOCDA=$P(ACR0,U,2)
Q:'ACRDOCDA
Q:'$D(^ACRDOC(ACRDOCDA,"TO"))
S ACRDOCTO=^ACRDOC(ACRDOCDA,"TO")
I $D(ACRBEGIN),ACRBEGIN Q:$P(ACRDOCTO,U,14)<ACRBEGIN
I $D(ACREND),ACREND,$P(ACRDOCTO,U,14)>ACREND Q
I $D(ACRINVIT),$P($G(^AUTTLOC(+$P(ACRDOCTO,U,13),0)),U,4)=+$G(^ACRSYS(ACRADA,0)) Q
K ACRDOCTO
I ACRTVT["CAN",$P(ACR0,U,5)'=ACRZDA Q
I ACRTVT["CAN",+^ACRLOCB($P(ACR0,U,6),"DT")'=ACRFY Q
S ACROBJ=$P(ACR0,U,4)
S ACROBJ=$P($G(^AUTTOBJC(+ACROBJ,0)),U)
Q:$E(ACROBJ,1,2)'=21
I '$G(ACRDTL1) S ACROBJ="ALL"
S ACRCAN=$P(ACR0,U,5)
S ACRCAN=$P($G(^AUTTCAN(+ACRCAN,0)),U)
Q:ACRCAN=""
I $D(ACRINCMP) D INCOMP I $D(ACRQUIT) K ACRQUIT Q
S:'$D(^TMP("ACRTV",$J,ACROBJ)) ^TMP("ACRTV",$J,ACROBJ)=""
F ACRI=4,9,21 S @("ACR"_ACRI)=$P(ACRDT,U,ACRI)
N X
S X=^TMP("ACRTV",$J,ACROBJ)
S $P(X,U)=$P(X,U)+ACR4
S $P(X,U,2)=$P(X,U,2)+ACR9
S $P(X,U,3)=$P(X,U,3)+ACR21
S $P(X,U,4)=$P(X,U,4)+ACR21
S ^TMP("ACRTV",$J,ACROBJ)=X
I $D(ACRDTAIL) D
.S ACRDOC=$P(ACR0,U,3)
.S ACRPD=$O(^ACRDOC(ACRDOC,9,"B",0))
.S ACRTO=$G(^ACRDOC(ACRDOC,"TO"))
.S ACRPURP=$E($P($G(^ACROBL(ACRDOC,"JST")),U),1,27)
.S ACRREQ2=^ACRDOC(ACRDOC,"REQ2")
.S ACRDOC=^ACRDOC(ACRDOC,0)
.S ACRREF=$P(ACRDOC,U,13)
.S ACRREF=$P(^AUTTDOCR(ACRREF,0),U)
.S:$P(ACRDOC,U,14)["CANCEL" ACRPURP="*"_ACRPURP
.I ACRPD,$D(^ACRPD(ACRPD,0)) S ACRPD=$P(^(0),U)
.I "^103^349^326^210^"'[(U_ACRREF_U) D I 1
..S ACRDOC0=$P(ACRDOC,U)
..S ACRDOC2=""
.E D
..S ACRDOC2=$P(ACRDOC,U)
..S ACRDOC0=$S($L($P(ACRDOC,U,2))>3:$E($P(ACRDOC,U,2),4,99),1:$P(ACRDOC,U))
.I '$D(^TMP("ACRTV",$J,ACROBJ,ACRDOC0)) S X=$P(ACRTO,U,14)_U_ACRDOC0_U_$S($G(ACRPURP)]"":ACRPURP,1:$P(ACRDOC,U,14))_U_$P(ACRREQ2,U,8)
.E S X=^TMP("ACRTV",$J,ACROBJ,ACRDOC0)
.S $P(X,U,5)=$P(X,U,5)+ACR4
.S $P(X,U,6)=$P(X,U,6)+ACR9
.S $P(X,U,21)=$P(X,U,21)+ACR21
.S $P(X,U,11)=$P(ACRTO,U,15)
.S $P(X,U,12)=ACRPD
.S $P(X,U,13)=$P(ACRTO,U,9)
.S $P(X,U,14)=ACRCAN
.S:ACRDOC0'=ACRDOC2 $P(X,U,10)=ACRDOC2
.S ^TMP("ACRTV",$J,ACROBJ,ACRDOC0)=X
.I $D(ACRSIGS) D
..D SIGS
..S ^TMP("ACRTV",$J,ACROBJ,ACRDOC0,"SIGS")=$G(ACRD1)_U_$G(ACRD2)_U_$G(ACRD3)_U_$G(ACRD4)_U_$G(ACRD5)_U_$G(ACRD6)
.K ACR4,ACR21,ACR9,ACRDOC2
Q
INCOMP ;CHECK EACH DOCUMENT IF ONLY INCOMPLETE TV'S ARE BEING REPORTED
N ACRDOC0,ACRAPV,ACRAPDA,ACRAP0,ACRAPDT,ACRREFDA,ACRREF,ACRD1,ACRD2,ACRD3,ACRTV
S ACRDOC0=^ACRDOC(ACRDOCDA,0)
S ACRAPV=$G(^ACROBL(ACRDOCDA,"APV"))
I $P(ACRAPV,U,8)]"" D Q Q
S ACRREFDA=$O(^AUTTDOCR("B",600,0))
I $P(ACRDOC0,U,13)'=ACRREFDA D Q Q
I '$D(^ACRAPVS("AB",ACRDOCDA)) D Q Q
Q
SIGS Q:ACRSIGS=ACRDOCDA
K ACRD1,ACRD2,ACRD3,ACRD4,ACRD5,ACRD6
S ACRAPDA=0
S ACRSIGS=ACRDOCDA
F S ACRAPDA=$O(^ACRAPVS("AB",ACRDOCDA,ACRAPDA)) Q:'ACRAPDA S ACRAP0=$G(^ACRAPVS(ACRAPDA,0)),ACRAPDT=$G(^ACRAPVS(ACRAPDA,"DT")) D
.I $P(ACRAP0,U,3)=40 S ACRD1=$P(ACRAPDT,U,3),ACRD2=$P(ACRAPDT,U,4)
.I $P(ACRAP0,U,3)=45 S ACRD3=$P(ACRAPDT,U,4)
.I $P(ACRAP0,U,3)=37 S ACRD4=$P(ACRAPDT,U,4)
.I $P(ACRAP0,U,3)=39 S ACRD5=$P(ACRAPDT,U,4)
.I $P(ACRAP0,U,3)=38 S ACRD6=$P(ACRAPDT,U,4)
Q
Q S ACRQUIT=""
Q
TDAY ;EP;TO SORT REPORT BY TRAVEL DAY SPECIFIC ITEMS
K ^TMP("ACRTVD",$J)
S ACRBEG=ACRBEGIN
S (ACRREQ,ACROBL,ACRSPT)=0
F S ACRBEG=$O(^ACRTV("E",ACRBEG)) Q:'ACRBEG!$D(ACROUT)!$D(ACRQUIT)!(ACRBEG>ACREND) D
.S ACRTVDA=0
.F S ACRTVDA=$O(^ACRTV("E",ACRBEG,ACRTVDA)) Q:'ACRTVDA!$D(ACROUT)!$D(ACRQUIT) D
..S ACRTV0=$G(^ACRTV(ACRTVDA,0))
..S ACRTVDT=$G(^ACRTV(ACRTVDA,"DT"))
..S ACRDOCDA=$P(ACRTV0,U,2)
..I ACRTVT="RC",$P(ACRTVDT,U,13)]"",'$D(^TMP("ACRTVD",$J,ACRDOCDA)) D
...S ^TMP("ACRTVD",$J,ACRDOCDA)=""
...D TD1
..I ACRTVT="LOC",$P(ACRTVDT,U,4)=ACRLOC,'$D(^TMP("ACRTVD",$J,ACRDOCDA)) D
...S ^TMP("ACRTVD",$J,ACRDOCDA)=""
...D TD1
K ^TMP("ACRTVD",$J)
Q
TD1 S ACRSSDA=0
F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA D
.S ACR0=$G(^ACRSS(ACRSSDA,0))
.S ACRDT=$G(^ACRSS(ACRSSDA,"DT"))
.D SS5
Q
ACRFTV3 ;IHS/OIRM/DSD/THL,AEF - TRAVEL REPORT; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE TO PRINT TRAVEL REPORT
SS4 ;EP;
+1 SET (ACR,ACR4,ACR9,ACR21)=0
+2 IF ACRTVT'="D"
SET (ACRREQ,ACROBL,ACRSPT)=0
+3 FOR
SET ACR=$ORDER(^ACRSS(ACRTVT,ACRZDA,ACR))
IF 'ACR
QUIT
Begin DoDot:1
+4 IF '$DATA(^ACRSS(ACR,0))!'$DATA(^ACRSS(ACR,"DT"))
QUIT
+5 SET ACR0=^ACRSS(ACR,0)
+6 SET ACRDT=^ACRSS(ACR,"DT")
+7 DO SS5
End DoDot:1
+8 IF ACRTVT="D"!(ACRTVT="TDEPT")!(ACRTVT="PO")!(ACRTVT="C")
QUIT
+9 IF '$DATA(ACRQUIT)
IF $DATA(^TMP("ACRTV",$JOB))
DO SS1^ACRFTV2
+10 IF '$DATA(ACRQUIT)
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^ACRFWARN
+11 WRITE @IOF
+12 KILL ^TMP("ACRTV",$JOB)
+13 QUIT
SS5 SET ACRDOCDA=$PIECE(ACR0,U,2)
+1 IF 'ACRDOCDA
QUIT
+2 IF '$DATA(^ACRDOC(ACRDOCDA,"TO"))
QUIT
+3 SET ACRDOCTO=^ACRDOC(ACRDOCDA,"TO")
+4 IF $DATA(ACRBEGIN)
IF ACRBEGIN
IF $PIECE(ACRDOCTO,U,14)<ACRBEGIN
QUIT
+5 IF $DATA(ACREND)
IF ACREND
IF $PIECE(ACRDOCTO,U,14)>ACREND
QUIT
+6 IF $DATA(ACRINVIT)
IF $PIECE($GET(^AUTTLOC(+$PIECE(ACRDOCTO,U,13),0)),U,4)=+$GET(^ACRSYS(ACRADA,0))
QUIT
+7 KILL ACRDOCTO
+8 IF ACRTVT["CAN"
IF $PIECE(ACR0,U,5)'=ACRZDA
QUIT
+9 IF ACRTVT["CAN"
IF +^ACRLOCB($PIECE(ACR0,U,6),"DT")'=ACRFY
QUIT
+10 SET ACROBJ=$PIECE(ACR0,U,4)
+11 SET ACROBJ=$PIECE($GET(^AUTTOBJC(+ACROBJ,0)),U)
+12 IF $EXTRACT(ACROBJ,1,2)'=21
QUIT
+13 IF '$GET(ACRDTL1)
SET ACROBJ="ALL"
+14 SET ACRCAN=$PIECE(ACR0,U,5)
+15 SET ACRCAN=$PIECE($GET(^AUTTCAN(+ACRCAN,0)),U)
+16 IF ACRCAN=""
QUIT
+17 IF $DATA(ACRINCMP)
DO INCOMP
IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+18 IF '$DATA(^TMP("ACRTV",$JOB,ACROBJ))
SET ^TMP("ACRTV",$JOB,ACROBJ)=""
+19 FOR ACRI=4,9,21
SET @("ACR"_ACRI)=$PIECE(ACRDT,U,ACRI)
+20 NEW X
+21 SET X=^TMP("ACRTV",$JOB,ACROBJ)
+22 SET $PIECE(X,U)=$PIECE(X,U)+ACR4
+23 SET $PIECE(X,U,2)=$PIECE(X,U,2)+ACR9
+24 SET $PIECE(X,U,3)=$PIECE(X,U,3)+ACR21
+25 SET $PIECE(X,U,4)=$PIECE(X,U,4)+ACR21
+26 SET ^TMP("ACRTV",$JOB,ACROBJ)=X
+27 IF $DATA(ACRDTAIL)
Begin DoDot:1
+28 SET ACRDOC=$PIECE(ACR0,U,3)
+29 SET ACRPD=$ORDER(^ACRDOC(ACRDOC,9,"B",0))
+30 SET ACRTO=$GET(^ACRDOC(ACRDOC,"TO"))
+31 SET ACRPURP=$EXTRACT($PIECE($GET(^ACROBL(ACRDOC,"JST")),U),1,27)
+32 SET ACRREQ2=^ACRDOC(ACRDOC,"REQ2")
+33 SET ACRDOC=^ACRDOC(ACRDOC,0)
+34 SET ACRREF=$PIECE(ACRDOC,U,13)
+35 SET ACRREF=$PIECE(^AUTTDOCR(ACRREF,0),U)
+36 IF $PIECE(ACRDOC,U,14)["CANCEL"
SET ACRPURP="*"_ACRPURP
+37 IF ACRPD
IF $DATA(^ACRPD(ACRPD,0))
SET ACRPD=$PIECE(^(0),U)
+38 IF "^103^349^326^210^"'[(U_ACRREF_U)
Begin DoDot:2
+39 SET ACRDOC0=$PIECE(ACRDOC,U)
+40 SET ACRDOC2=""
End DoDot:2
IF 1
+41 IF '$TEST
Begin DoDot:2
+42 SET ACRDOC2=$PIECE(ACRDOC,U)
+43 SET ACRDOC0=$SELECT($LENGTH($PIECE(ACRDOC,U,2))>3:$EXTRACT($PIECE(ACRDOC,U,2),4,99),1:$PIECE(ACRDOC,U))
End DoDot:2
+44 IF '$DATA(^TMP("ACRTV",$JOB,ACROBJ,ACRDOC0))
SET X=$PIECE(ACRTO,U,14)_U_ACRDOC0_U_$SELECT($GET(ACRPURP)]"":ACRPURP,1:$PIECE(ACRDOC,U,14))_U_$PIECE(ACRREQ2,U,8)
+45 IF '$TEST
SET X=^TMP("ACRTV",$JOB,ACROBJ,ACRDOC0)
+46 SET $PIECE(X,U,5)=$PIECE(X,U,5)+ACR4
+47 SET $PIECE(X,U,6)=$PIECE(X,U,6)+ACR9
+48 SET $PIECE(X,U,21)=$PIECE(X,U,21)+ACR21
+49 SET $PIECE(X,U,11)=$PIECE(ACRTO,U,15)
+50 SET $PIECE(X,U,12)=ACRPD
+51 SET $PIECE(X,U,13)=$PIECE(ACRTO,U,9)
+52 SET $PIECE(X,U,14)=ACRCAN
+53 IF ACRDOC0'=ACRDOC2
SET $PIECE(X,U,10)=ACRDOC2
+54 SET ^TMP("ACRTV",$JOB,ACROBJ,ACRDOC0)=X
+55 IF $DATA(ACRSIGS)
Begin DoDot:2
+56 DO SIGS
+57 SET ^TMP("ACRTV",$JOB,ACROBJ,ACRDOC0,"SIGS")=$GET(ACRD1)_U_$GET(ACRD2)_U_$GET(ACRD3)_U_$GET(ACRD4)_U_$GET(ACRD5)_U_$GET(ACRD6)
End DoDot:2
+58 KILL ACR4,ACR21,ACR9,ACRDOC2
End DoDot:1
+59 QUIT
INCOMP ;CHECK EACH DOCUMENT IF ONLY INCOMPLETE TV'S ARE BEING REPORTED
+1 NEW ACRDOC0,ACRAPV,ACRAPDA,ACRAP0,ACRAPDT,ACRREFDA,ACRREF,ACRD1,ACRD2,ACRD3,ACRTV
+2 SET ACRDOC0=^ACRDOC(ACRDOCDA,0)
+3 SET ACRAPV=$GET(^ACROBL(ACRDOCDA,"APV"))
+4 IF $PIECE(ACRAPV,U,8)]""
DO Q
QUIT
+5 SET ACRREFDA=$ORDER(^AUTTDOCR("B",600,0))
+6 IF $PIECE(ACRDOC0,U,13)'=ACRREFDA
DO Q
QUIT
+7 IF '$DATA(^ACRAPVS("AB",ACRDOCDA))
DO Q
QUIT
+8 QUIT
SIGS IF ACRSIGS=ACRDOCDA
QUIT
+1 KILL ACRD1,ACRD2,ACRD3,ACRD4,ACRD5,ACRD6
+2 SET ACRAPDA=0
+3 SET ACRSIGS=ACRDOCDA
+4 FOR
SET ACRAPDA=$ORDER(^ACRAPVS("AB",ACRDOCDA,ACRAPDA))
IF 'ACRAPDA
QUIT
SET ACRAP0=$GET(^ACRAPVS(ACRAPDA,0))
SET ACRAPDT=$GET(^ACRAPVS(ACRAPDA,"DT"))
Begin DoDot:1
+5 IF $PIECE(ACRAP0,U,3)=40
SET ACRD1=$PIECE(ACRAPDT,U,3)
SET ACRD2=$PIECE(ACRAPDT,U,4)
+6 IF $PIECE(ACRAP0,U,3)=45
SET ACRD3=$PIECE(ACRAPDT,U,4)
+7 IF $PIECE(ACRAP0,U,3)=37
SET ACRD4=$PIECE(ACRAPDT,U,4)
+8 IF $PIECE(ACRAP0,U,3)=39
SET ACRD5=$PIECE(ACRAPDT,U,4)
+9 IF $PIECE(ACRAP0,U,3)=38
SET ACRD6=$PIECE(ACRAPDT,U,4)
End DoDot:1
+10 QUIT
Q SET ACRQUIT=""
+1 QUIT
TDAY ;EP;TO SORT REPORT BY TRAVEL DAY SPECIFIC ITEMS
+1 KILL ^TMP("ACRTVD",$JOB)
+2 SET ACRBEG=ACRBEGIN
+3 SET (ACRREQ,ACROBL,ACRSPT)=0
+4 FOR
SET ACRBEG=$ORDER(^ACRTV("E",ACRBEG))
IF 'ACRBEG!$DATA(ACROUT)!$DATA(ACRQUIT)!(ACRBEG>ACREND)
QUIT
Begin DoDot:1
+5 SET ACRTVDA=0
+6 FOR
SET ACRTVDA=$ORDER(^ACRTV("E",ACRBEG,ACRTVDA))
IF 'ACRTVDA!$DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+7 SET ACRTV0=$GET(^ACRTV(ACRTVDA,0))
+8 SET ACRTVDT=$GET(^ACRTV(ACRTVDA,"DT"))
+9 SET ACRDOCDA=$PIECE(ACRTV0,U,2)
+10 IF ACRTVT="RC"
IF $PIECE(ACRTVDT,U,13)]""
IF '$DATA(^TMP("ACRTVD",$JOB,ACRDOCDA))
Begin DoDot:3
+11 SET ^TMP("ACRTVD",$JOB,ACRDOCDA)=""
+12 DO TD1
End DoDot:3
+13 IF ACRTVT="LOC"
IF $PIECE(ACRTVDT,U,4)=ACRLOC
IF '$DATA(^TMP("ACRTVD",$JOB,ACRDOCDA))
Begin DoDot:3
+14 SET ^TMP("ACRTVD",$JOB,ACRDOCDA)=""
+15 DO TD1
End DoDot:3
End DoDot:2
End DoDot:1
+16 KILL ^TMP("ACRTVD",$JOB)
+17 QUIT
TD1 SET ACRSSDA=0
+1 FOR
SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:1
+2 SET ACR0=$GET(^ACRSS(ACRSSDA,0))
+3 SET ACRDT=$GET(^ACRSS(ACRSSDA,"DT"))
+4 DO SS5
End DoDot:1
+5 QUIT
