- ACRFTV2 ;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
- SS ;EP;TO PRINT TRAVEL REPORT
- K ^TMP("ACRTV",$J)
- D EN1
- EXIT D EXIT^ACRFTV
- Q
- EN1 I $D(ACRBOTH) D Q
- .K ACRDTAIL
- .D SS0
- .S ACRDTAIL=""
- .S (ACRREQ,ACROBL,ACRSPT)=0
- .D SS0
- .K ^TMP("ACRTV",$J)
- SS0 Q:$D(ACRQUIT)!$D(ACROUT)
- U IO
- S (ACRREQT,ACROBLT,ACRSPTT)=0
- I ACRTVT="D" D T Q
- I ACRTVT="AE"!(ACRTVT="NCC") D T1 Q
- I ACRTVT="TDEPT"!(ACRTVT="PO") D PDEPT^ACRFTV1 Q
- I ACRTVT="RC"!(ACRTVT="LOC") D TDAY^ACRFTV3 I 1
- E D:ACRTVT'="C" SS4^ACRFTV3
- SS1 ;EP;
- N ACRFY
- D DISPLAY^ACRFTV1
- I '$D(ACRDTAIL) D
- .D H1^ACRFTV1
- .D SS3^ACRFTV1
- S ACROBJ=$S($G(ACRDTL1):"",1:"ALL")
- S ACR=""
- F S ACR=$O(^TMP("ACRTV",$J,ACR)) Q:ACR=""!$D(ACRQUIT)!$D(ACROUT) D
- .I $D(ACRDTAIL) D SS2^ACRFTV1
- .Q:$D(ACRQUIT)!$D(ACROUT)
- .S ACR0=^TMP("ACRTV",$J,ACR)
- .F ACRI=1:1:4 S @("ACR"_ACRI)=$P(ACR0,U,ACRI)
- .I $G(ACRDTL1) D Q:$D(ACRQUIT)!$D(ACROUT)
- ..D ALL
- ..W ?50,$J($FN(ACR1,"P,",2),15)
- ..W ?64,$J($FN(ACR2,"P,",2),15)
- ..W:ION<81 !?65
- ..W:ION>80 ?80
- ..W $J($FN(ACR4,"P,",2),15)
- ..I $D(ACRDTAIL) D Q:$D(ACRQUIT)!$D(ACROUT)
- ...D PAUSE^ACRFWARN:$D(ACRDTAIL)
- ...W:$E(IOST,1,2)="C-" @IOF
- .S ACRREQ=ACRREQ+ACR1
- .S ACROBL=ACROBL+ACR2
- .S ACRSPT=ACRSPT+ACR4
- .I $D(ACRREQT) D
- ..S ACRREQT=ACRREQT+ACR1
- ..S ACROBLT=ACROBLT+ACR2
- ..S ACRSPTT=ACRSPTT+ACR4
- .I $Y>(IOSL-5) D
- ..D PAUSE^ACRFWARN
- ..Q:$D(ACRQUIT)!$D(ACROUT)
- ..W @IOF
- ..D H1^ACRFTV1:$D(ACRDTAIL)
- Q:$D(ACRQUIT)!$D(ACROUT)
- D ALL
- W ?50,$J($FN(ACRREQ,"P,",2),15)
- W ?64,$J($FN(ACROBL,"P,",2),15)
- W:ION<81 !?65
- W:ION>80 ?80
- W $J($FN(ACRSPT,"P,",2),15)
- I $D(ACRSIGT) D SIGT^ACRFTV I 1
- E D PAUSE^ACRFWARN:$D(ACRDTAIL)
- Q
- ALL ;
- I '$D(ACRDTAIL) W:ACR="" $$DASH^ACRFMENU
- E W $$DASH^ACRFMENU
- I ACR]"",ACR'="ALL",ACROBJ'="ALL",ACROBJ'=ACR D
- .S ACROBJ=ACR
- .W !?10,"TOTALS FOR OBJECT CODE: ",ACR
- E D
- .I $L(ACR)=4 W !?10,"TOTALS FOR OBJECT CODE: ",ACR
- .E W !?10,"TOTAL:"
- Q
- T ;TO PRINT TRAVEL REPORT FOR SELECTED TRAVELERS
- F ACRJ=2:1 S ACRTVDA=$P(ACRTRAV,U,ACRJ) Q:ACRTVDA="" D T1
- I $L(ACRTRAV,U)>3 D
- .W $$DASH^ACRFMENU
- .W !?10,"TOTAL FOR SELECTED TRAVELERS:"
- .W ?50,$J($FN(ACRREQT,"P,",2),15)
- .W ?64,$J($FN(ACROBLT,"P,",2),15)
- .W:ION<81 !?65
- .W:ION>80 ?80
- .W $J($FN(ACRSPTT,"P,",2),15)
- .I $D(ACRSIGT) D SIGT^ACRFTV
- .I $E(IOST,1,2)="C-" D PAUSE^ACRFWARN
- W @IOF
- Q
- T1 K ^TMP("ACRTV",$J)
- S (ACRREQ,ACROBL,ACRSPT)=0
- I ACRTVT="D" D
- .S ACRZDA=0
- .F S ACRZDA=$O(^ACRDOC("N",ACRTVDA,ACRZDA)) Q:'ACRZDA D
- ..Q:'$D(^ACRDOC(ACRZDA,"TO"))
- ..S ACRTO=^ACRDOC(ACRZDA,"TO")
- ..S ACRFR=$P(ACRTO,U,14)
- ..S ACRTO=$P(ACRTO,U,15)
- ..I ACRFR>(ACRBEGIN-1),ACRTO<(ACREND+1) D
- ...S ACRTVT="D"
- ...D SS4^ACRFTV3
- I ACRTVT="AE"!(ACRTVT="NCC") D
- .S ACRBEG=ACRBEGIN
- .F S ACRBEG=$O(^ACRDOC("DD",ACRBEG)) Q:'ACRBEG!(ACRBEG>ACREND) D
- ..S ACRZDA=0
- ..F S ACRZDA=$O(^ACRDOC("DD",ACRBEG,ACRZDA)) Q:'ACRZDA!(ACRBEG>ACREND) D
- ...I ACRTVT="AE",$P($G(^ACRDOC(ACRZDA,"TOTV")),U,4)="A" D Q
- ....S ACRTVT="D"
- ....D SS4^ACRFTV3
- ....S ACRTVT="AE"
- ...I ACRTVT="NCC" D
- ....S ACRALDA=0
- ....F S ACRALDA=$O(^ACRAL("E",ACRZDA,ACRALDA)) Q:'ACRALDA!$D(ACRQUIT) I $P($G(^ACRAL(ACRALDA,"DT")),U,11)]"",$P(^("DT"),U,11)'="00" D
- .....S ACRTVT="D"
- .....D SS4^ACRFTV3
- .....S ACRTVT="NCC",ACRQUIT=""
- ....K ACRQUIT
- D SS1
- I $D(ACRSIGT) D SIGT^ACRFTV I 1
- E D PAUSE^ACRFWARN:'$D(ACRDTAIL)
- W:$D(ACRDTAIL) @IOF
- Q
- ACRFTV2 ;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
- SS ;EP;TO PRINT TRAVEL REPORT
- +1 KILL ^TMP("ACRTV",$JOB)
- +2 DO EN1
- EXIT DO EXIT^ACRFTV
- +1 QUIT
- EN1 IF $DATA(ACRBOTH)
- Begin DoDot:1
- +1 KILL ACRDTAIL
- +2 DO SS0
- +3 SET ACRDTAIL=""
- +4 SET (ACRREQ,ACROBL,ACRSPT)=0
- +5 DO SS0
- +6 KILL ^TMP("ACRTV",$JOB)
- End DoDot:1
- QUIT
- SS0 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +1 USE IO
- +2 SET (ACRREQT,ACROBLT,ACRSPTT)=0
- +3 IF ACRTVT="D"
- DO T
- QUIT
- +4 IF ACRTVT="AE"!(ACRTVT="NCC")
- DO T1
- QUIT
- +5 IF ACRTVT="TDEPT"!(ACRTVT="PO")
- DO PDEPT^ACRFTV1
- QUIT
- +6 IF ACRTVT="RC"!(ACRTVT="LOC")
- DO TDAY^ACRFTV3
- IF 1
- +7 IF '$TEST
- IF ACRTVT'="C"
- DO SS4^ACRFTV3
- SS1 ;EP;
- +1 NEW ACRFY
- +2 DO DISPLAY^ACRFTV1
- +3 IF '$DATA(ACRDTAIL)
- Begin DoDot:1
- +4 DO H1^ACRFTV1
- +5 DO SS3^ACRFTV1
- End DoDot:1
- +6 SET ACROBJ=$SELECT($GET(ACRDTL1):"",1:"ALL")
- +7 SET ACR=""
- +8 FOR
- SET ACR=$ORDER(^TMP("ACRTV",$JOB,ACR))
- IF ACR=""!$DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- Begin DoDot:1
- +9 IF $DATA(ACRDTAIL)
- DO SS2^ACRFTV1
- +10 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +11 SET ACR0=^TMP("ACRTV",$JOB,ACR)
- +12 FOR ACRI=1:1:4
- SET @("ACR"_ACRI)=$PIECE(ACR0,U,ACRI)
- +13 IF $GET(ACRDTL1)
- Begin DoDot:2
- +14 DO ALL
- +15 WRITE ?50,$JUSTIFY($FNUMBER(ACR1,"P,",2),15)
- +16 WRITE ?64,$JUSTIFY($FNUMBER(ACR2,"P,",2),15)
- +17 IF ION<81
- WRITE !?65
- +18 IF ION>80
- WRITE ?80
- +19 WRITE $JUSTIFY($FNUMBER(ACR4,"P,",2),15)
- +20 IF $DATA(ACRDTAIL)
- Begin DoDot:3
- +21 IF $DATA(ACRDTAIL)
- DO PAUSE^ACRFWARN
- +22 IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- End DoDot:3
- IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- End DoDot:2
- IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +23 SET ACRREQ=ACRREQ+ACR1
- +24 SET ACROBL=ACROBL+ACR2
- +25 SET ACRSPT=ACRSPT+ACR4
- +26 IF $DATA(ACRREQT)
- Begin DoDot:2
- +27 SET ACRREQT=ACRREQT+ACR1
- +28 SET ACROBLT=ACROBLT+ACR2
- +29 SET ACRSPTT=ACRSPTT+ACR4
- End DoDot:2
- +30 IF $Y>(IOSL-5)
- Begin DoDot:2
- +31 DO PAUSE^ACRFWARN
- +32 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +33 WRITE @IOF
- +34 IF $DATA(ACRDTAIL)
- DO H1^ACRFTV1
- End DoDot:2
- End DoDot:1
- +35 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +36 DO ALL
- +37 WRITE ?50,$JUSTIFY($FNUMBER(ACRREQ,"P,",2),15)
- +38 WRITE ?64,$JUSTIFY($FNUMBER(ACROBL,"P,",2),15)
- +39 IF ION<81
- WRITE !?65
- +40 IF ION>80
- WRITE ?80
- +41 WRITE $JUSTIFY($FNUMBER(ACRSPT,"P,",2),15)
- +42 IF $DATA(ACRSIGT)
- DO SIGT^ACRFTV
- IF 1
- +43 IF '$TEST
- IF $DATA(ACRDTAIL)
- DO PAUSE^ACRFWARN
- +44 QUIT
- ALL ;
- +1 IF '$DATA(ACRDTAIL)
- IF ACR=""
- WRITE $$DASH^ACRFMENU
- +2 IF '$TEST
- WRITE $$DASH^ACRFMENU
- +3 IF ACR]""
- IF ACR'="ALL"
- IF ACROBJ'="ALL"
- IF ACROBJ'=ACR
- Begin DoDot:1
- +4 SET ACROBJ=ACR
- +5 WRITE !?10,"TOTALS FOR OBJECT CODE: ",ACR
- End DoDot:1
- +6 IF '$TEST
- Begin DoDot:1
- +7 IF $LENGTH(ACR)=4
- WRITE !?10,"TOTALS FOR OBJECT CODE: ",ACR
- +8 IF '$TEST
- WRITE !?10,"TOTAL:"
- End DoDot:1
- +9 QUIT
- T ;TO PRINT TRAVEL REPORT FOR SELECTED TRAVELERS
- +1 FOR ACRJ=2:1
- SET ACRTVDA=$PIECE(ACRTRAV,U,ACRJ)
- IF ACRTVDA=""
- QUIT
- DO T1
- +2 IF $LENGTH(ACRTRAV,U)>3
- Begin DoDot:1
- +3 WRITE $$DASH^ACRFMENU
- +4 WRITE !?10,"TOTAL FOR SELECTED TRAVELERS:"
- +5 WRITE ?50,$JUSTIFY($FNUMBER(ACRREQT,"P,",2),15)
- +6 WRITE ?64,$JUSTIFY($FNUMBER(ACROBLT,"P,",2),15)
- +7 IF ION<81
- WRITE !?65
- +8 IF ION>80
- WRITE ?80
- +9 WRITE $JUSTIFY($FNUMBER(ACRSPTT,"P,",2),15)
- +10 IF $DATA(ACRSIGT)
- DO SIGT^ACRFTV
- +11 IF $EXTRACT(IOST,1,2)="C-"
- DO PAUSE^ACRFWARN
- End DoDot:1
- +12 WRITE @IOF
- +13 QUIT
- T1 KILL ^TMP("ACRTV",$JOB)
- +1 SET (ACRREQ,ACROBL,ACRSPT)=0
- +2 IF ACRTVT="D"
- Begin DoDot:1
- +3 SET ACRZDA=0
- +4 FOR
- SET ACRZDA=$ORDER(^ACRDOC("N",ACRTVDA,ACRZDA))
- IF 'ACRZDA
- QUIT
- Begin DoDot:2
- +5 IF '$DATA(^ACRDOC(ACRZDA,"TO"))
- QUIT
- +6 SET ACRTO=^ACRDOC(ACRZDA,"TO")
- +7 SET ACRFR=$PIECE(ACRTO,U,14)
- +8 SET ACRTO=$PIECE(ACRTO,U,15)
- +9 IF ACRFR>(ACRBEGIN-1)
- IF ACRTO<(ACREND+1)
- Begin DoDot:3
- +10 SET ACRTVT="D"
- +11 DO SS4^ACRFTV3
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 IF ACRTVT="AE"!(ACRTVT="NCC")
- Begin DoDot:1
- +13 SET ACRBEG=ACRBEGIN
- +14 FOR
- SET ACRBEG=$ORDER(^ACRDOC("DD",ACRBEG))
- IF 'ACRBEG!(ACRBEG>ACREND)
- QUIT
- Begin DoDot:2
- +15 SET ACRZDA=0
- +16 FOR
- SET ACRZDA=$ORDER(^ACRDOC("DD",ACRBEG,ACRZDA))
- IF 'ACRZDA!(ACRBEG>ACREND)
- QUIT
- Begin DoDot:3
- +17 IF ACRTVT="AE"
- IF $PIECE($GET(^ACRDOC(ACRZDA,"TOTV")),U,4)="A"
- Begin DoDot:4
- +18 SET ACRTVT="D"
- +19 DO SS4^ACRFTV3
- +20 SET ACRTVT="AE"
- End DoDot:4
- QUIT
- +21 IF ACRTVT="NCC"
- Begin DoDot:4
- +22 SET ACRALDA=0
- +23 FOR
- SET ACRALDA=$ORDER(^ACRAL("E",ACRZDA,ACRALDA))
- IF 'ACRALDA!$DATA(ACRQUIT)
- QUIT
- IF $PIECE($GET(^ACRAL(ACRALDA,"DT")),U,11)]""
- IF $PIECE(^("DT"),U,11)'="00"
- Begin DoDot:5
- +24 SET ACRTVT="D"
- +25 DO SS4^ACRFTV3
- +26 SET ACRTVT="NCC"
- SET ACRQUIT=""
- End DoDot:5
- +27 KILL ACRQUIT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +28 DO SS1
- +29 IF $DATA(ACRSIGT)
- DO SIGT^ACRFTV
- IF 1
- +30 IF '$TEST
- IF '$DATA(ACRDTAIL)
- DO PAUSE^ACRFWARN
- +31 IF $DATA(ACRDTAIL)
- WRITE @IOF
- +32 QUIT
