ACRFPAY9.m

ACRFPAY9 ;IHS/OIRM/DSD/THL,AEF - PAYMENT REPORTS, UTILITIES;  [ 09/23/2005  9:51 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,19**;NOV 05, 2001

 ;;

TECHPAY ;EP;TO PRINT PAYMENTS MADE BY ONE ACCOUNTING TECH

 D TPEXIT

 F  D TP Q:$D(ACRQUIT)!$D(ACROUT)

TPEXIT K ACR,ACRTDA,ACRQUIT,ACROUT,ACRBEGIN,ACROUT,ACRFY,ACRFYDA,ACRBATDA,ACRBATNO,ACREND,ACRRTN

 K ^TMP("ACRPBAT",$J)

 Q

TP ;

 D TPHEAD

 D TECH

 Q:$D(ACRQUIT)!'$G(ACRTDA)

 D FY

 Q:$D(ACRQUIT)!'$G(ACRFYDA)

 D DATES

 Q:$D(ACRQUIT)!'$G(ACRBEGIN)!'$G(ACREND)

 D ZIS

 Q

TECH ;LOOK UP ACCOUNTING TECH

 S DIC="^ACRAU("

 S DIC(0)="AEMQZ"

 S DIC("A")="Which ACCOUNTING TECH: "

 S DIC("S")="I $D(^AFSLAFP(""D"",+Y))"

 W !

 D DIC^ACRFDIC

 I Y<1 S ACRQUIT=""

 S ACRTDA=+Y

 Q

FY ;SELECT FISCAL YEAR FOR REPORT

 S DIR(0)="NO^1000:9999"

 S DIR("A")="Which FISCAL YEAR"

 S DIR("B")=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)

 W !

 D DIR^ACRFDIC

 Q:Y=""

 S ACRFY=Y

 S ACRFYDA=$O(^AFSLAFP("B",ACRFY,0))

 Q

DATES ;SELECT DATE RANGE FOR PAYMENTS TO REVIEW

 W !

 D ^ACRFDATE

 Q

ZIS ;SELECT DEVICE TO PRINT REPORT

 S (ZTRTN,ACRRTN)="TP1^ACRFPAY9"

 S ZTDESC="REVIEW PAYMENTS FOR SELECTED TECH"

 D ^ACRFZIS

 Q

TP1 ;EP;TO PRINT TECH PAYMENTS REPORT

 Q:'$G(ACRFYDA)!'$G(ACRTDA)

 N ACRBATDA

 S ACRBATDA=0

 F  S ACRBATDA=$O(^AFSLAFP("D",ACRTDA,ACRFYDA,ACRBATDA)) Q:'ACRBATDA  D

 .Q:$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,2)<ACRBEGIN  Q:$P(^(2),U,2)>ACREND

 .N ACRSEQDA

 .S ACRSEQDA=0

 .F  S ACRSEQDA=$O(^AFSLAFP("D",ACRTDA,ACRFYDA,ACRBATDA,ACRSEQDA)) Q:'ACRSEQDA  D

 ..S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))

 ..Q:'$P(X,U,10)&'$P(X,U,24)

 ..I $P(X,U,10) S X=$P($G(^AUTTVNDR($P(X,U,10),0)),U)

 ..;E  S:$P(X,U,24) X=$P($G(^VA(200,$P(X,U,24),0)),U)  ;ACR*2.1*19.02 IM16848

 ..E  S:$P(X,U,24) X=$$NAME2^ACRFUTL1($P(X,U,24))  ;ACR*2.1*19.02 IM16848

 ..Q:X=""

 ..S ^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,X,ACRSEQDA)=""

 S ACRBATDA=0

 F  S ACRBATDA=$O(^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA)) Q:'ACRBATDA!$D(ACRQUIT)  D

 .S ACRBATNO=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)

 .D PBHEAD^ACRFPAY7

 .N ACRX

 .S ACRX=""

 .F  S ACRX=$O(^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,ACRX)) Q:ACRX=""!$D(ACRQUIT)  D

 ..S ACRSEQDA=0

 ..F  S ACRSEQDA=$O(^TMP("ACRPBAT",$J,ACRFYDA,ACRBATDA,ACRX,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT)  D PBD1^ACRFPAY7

 D TPEXIT

 Q

TPHEAD ;

 W @IOF

 W !?10,"Review Payments for a Selected Accounting Tech",!

 Q

PTYPE ;EP;SELECT PAYMENT TYPE

 S DIC="^AFSLPTYP("

 S DIC(0)="AEMQZ"

 S DIC("A")="PAYMENT TYPE........: "

 S DIC("B")=$S(ACRBTYP="V"&$G(ACRDFYDA):"OBLIGATED PMT",ACRBTYP="V"&'$G(ACRDFYDA):"UNOBLIGATED PAYMENT (19013)",1:"TRAVEL DISBRSMENT")

 D DIC^ACRFDIC

 I X["^" S ACROUT="" Q

 I +Y<1 W !!,"PAYMENT TYPE REQUIRED",! G PTYPE

 S (ACR3,Y)=+Y

 S ACRTCODE=$S(Y=2:"06115",Y=3:24219,Y=6:"06125",Y=11:19217,Y=12:19917,Y=14:19817,Y=15:19013,Y=16:23717,1:19114)   ;ACR*2.1*5.01

 I ACRTCODE="06115" D OTA          ;ACR*2.1*5.01

 Q

OTA ;EP;SYNCHRONIZE TRAVEL ADVANCE

 S ACRREF=602

 S ACRREFDA=$O(^AUTTDOCR("B",602,0))

 N ACRDOCDA

 S ACRDOCDA=$O(^ACRDOC("B",ACRDOC,0))

 Q:'ACRDOCDA

 S ACRADV=ACRIVT

 D OTA^ACRFSSA1

 Q

FYFUN ;EP;FISCAL YEAR OF FUNDS

 K ACRFY

 S DIR(0)="NO^1000:9999"

 S DIR("A")="FISCAL YEAR OF FUNDS"

 S DIR("B")=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)

 D DIR^ACRFDIC

 I X["^" S ACROUT="" Q

 I $L(Y)'=4 W !!,"FISCAL YEAR OF FUNDS REQUIRED",! G FYFUN

 S ACRFYFUN=Y

 S $P(ACRLBDT,U)=ACRFYFUN

 Q

ACRFPAY9  ;IHS/OIRM/DSD/THL,AEF - PAYMENT REPORTS, UTILITIES;  [ 09/23/2005  9:51 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,19**;NOV 05, 2001

 +2       ;;

TECHPAY   ;EP;TO PRINT PAYMENTS MADE BY ONE ACCOUNTING TECH

 +1        DO TPEXIT

 +2        FOR 

               DO TP

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT 

TPEXIT     KILL ACR,ACRTDA,ACRQUIT,ACROUT,ACRBEGIN,ACROUT,ACRFY,ACRFYDA,ACRBATDA,ACRBATNO,ACREND,ACRRTN

 +1        KILL ^TMP("ACRPBAT",$JOB)

 +2        QUIT 

TP        ;

 +1        DO TPHEAD

 +2        DO TECH

 +3        IF $DATA(ACRQUIT)!'$GET(ACRTDA)

               QUIT 

 +4        DO FY

 +5        IF $DATA(ACRQUIT)!'$GET(ACRFYDA)

               QUIT 

 +6        DO DATES

 +7        IF $DATA(ACRQUIT)!'$GET(ACRBEGIN)!'$GET(ACREND)

               QUIT 

 +8        DO ZIS

 +9        QUIT 

TECH      ;LOOK UP ACCOUNTING TECH

 +1        SET DIC="^ACRAU("

 +2        SET DIC(0)="AEMQZ"

 +3        SET DIC("A")="Which ACCOUNTING TECH: "

 +4        SET DIC("S")="I $D(^AFSLAFP(""D"",+Y))"

 +5        WRITE !

 +6        DO DIC^ACRFDIC

 +7        IF Y<1

               SET ACRQUIT=""

 +8        SET ACRTDA=+Y

 +9        QUIT 

FY        ;SELECT FISCAL YEAR FOR REPORT

 +1        SET DIR(0)="NO^1000:9999"

 +2        SET DIR("A")="Which FISCAL YEAR"

 +3        SET DIR("B")=$SELECT($EXTRACT(DT,4,5)<10:$EXTRACT(DT,1,3)+1700,1:($EXTRACT(DT,1,3)+1)+1700)

 +4        WRITE !

 +5        DO DIR^ACRFDIC

 +6        IF Y=""

               QUIT 

 +7        SET ACRFY=Y

 +8        SET ACRFYDA=$ORDER(^AFSLAFP("B",ACRFY,0))

 +9        QUIT 

DATES     ;SELECT DATE RANGE FOR PAYMENTS TO REVIEW

 +1        WRITE !

 +2        DO ^ACRFDATE

 +3        QUIT 

ZIS       ;SELECT DEVICE TO PRINT REPORT

 +1        SET (ZTRTN,ACRRTN)="TP1^ACRFPAY9"

 +2        SET ZTDESC="REVIEW PAYMENTS FOR SELECTED TECH"

 +3        DO ^ACRFZIS

 +4        QUIT 

TP1       ;EP;TO PRINT TECH PAYMENTS REPORT

 +1        IF '$GET(ACRFYDA)!'$GET(ACRTDA)

               QUIT 

 +2        NEW ACRBATDA

 +3        SET ACRBATDA=0

 +4        FOR 

               SET ACRBATDA=$ORDER(^AFSLAFP("D",ACRTDA,ACRFYDA,ACRBATDA))

               IF 'ACRBATDA

                   QUIT 

               Begin DoDot:1

 +5                IF $PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,2)<ACRBEGIN

                       QUIT 

                   IF $PIECE(^(2),U,2)>ACREND

                       QUIT 

 +6                NEW ACRSEQDA

 +7                SET ACRSEQDA=0

 +8                FOR 

                       SET ACRSEQDA=$ORDER(^AFSLAFP("D",ACRTDA,ACRFYDA,ACRBATDA,ACRSEQDA))

                       IF 'ACRSEQDA

                           QUIT 

                       Begin DoDot:2

 +9                        SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))

 +10                       IF '$PIECE(X,U,10)&'$PIECE(X,U,24)

                               QUIT 

 +11                       IF $PIECE(X,U,10)

                               SET X=$PIECE($GET(^AUTTVNDR($PIECE(X,U,10),0)),U)

 +12      ;E  S:$P(X,U,24) X=$P($G(^VA(200,$P(X,U,24),0)),U)  ;ACR*2.1*19.02 IM16848

 +13      ;ACR*2.1*19.02 IM16848

                          IF '$TEST

                               IF $PIECE(X,U,24)

                                   SET X=$$NAME2^ACRFUTL1($PIECE(X,U,24))

 +14                       IF X=""

                               QUIT 

 +15                       SET ^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,X,ACRSEQDA)=""

                       End DoDot:2

               End DoDot:1

 +16       SET ACRBATDA=0

 +17       FOR 

               SET ACRBATDA=$ORDER(^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA))

               IF 'ACRBATDA!$DATA(ACRQUIT)

                   QUIT 

               Begin DoDot:1

 +18               SET ACRBATNO=$PIECE(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)

 +19               DO PBHEAD^ACRFPAY7

 +20               NEW ACRX

 +21               SET ACRX=""

 +22               FOR 

                       SET ACRX=$ORDER(^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,ACRX))

                       IF ACRX=""!$DATA(ACRQUIT)

                           QUIT 

                       Begin DoDot:2

 +23                       SET ACRSEQDA=0

 +24                       FOR 

                               SET ACRSEQDA=$ORDER(^TMP("ACRPBAT",$JOB,ACRFYDA,ACRBATDA,ACRX,ACRSEQDA))

                               IF 'ACRSEQDA!$DATA(ACRQUIT)

                                   QUIT 

                               DO PBD1^ACRFPAY7

                       End DoDot:2

               End DoDot:1

 +25       DO TPEXIT

 +26       QUIT 

TPHEAD    ;

 +1        WRITE @IOF

 +2        WRITE !?10,"Review Payments for a Selected Accounting Tech",!

 +3        QUIT 

PTYPE     ;EP;SELECT PAYMENT TYPE

 +1        SET DIC="^AFSLPTYP("

 +2        SET DIC(0)="AEMQZ"

 +3        SET DIC("A")="PAYMENT TYPE........: "

 +4        SET DIC("B")=$SELECT(ACRBTYP="V"&$GET(ACRDFYDA):"OBLIGATED PMT",ACRBTYP="V"&'$GET(ACRDFYDA):"UNOBLIGATED PAYMENT (19013)",1:"TRAVEL DISBRSMENT")

 +5        DO DIC^ACRFDIC

 +6        IF X["^"

               SET ACROUT=""

               QUIT 

 +7        IF +Y<1

               WRITE !!,"PAYMENT TYPE REQUIRED",!

               GOTO PTYPE

 +8        SET (ACR3,Y)=+Y

 +9       ;ACR*2.1*5.01

           SET ACRTCODE=$SELECT(Y=2:"06115",Y=3:24219,Y=6:"06125",Y=11:19217,Y=12:19917,Y=14:19817,Y=15:19013,Y=16:23717,1:19114)

 +10      ;ACR*2.1*5.01

           IF ACRTCODE="06115"

               DO OTA

 +11       QUIT 

OTA       ;EP;SYNCHRONIZE TRAVEL ADVANCE

 +1        SET ACRREF=602

 +2        SET ACRREFDA=$ORDER(^AUTTDOCR("B",602,0))

 +3        NEW ACRDOCDA

 +4        SET ACRDOCDA=$ORDER(^ACRDOC("B",ACRDOC,0))

 +5        IF 'ACRDOCDA

               QUIT 

 +6        SET ACRADV=ACRIVT

 +7        DO OTA^ACRFSSA1

 +8        QUIT 

FYFUN     ;EP;FISCAL YEAR OF FUNDS

 +1        KILL ACRFY

 +2        SET DIR(0)="NO^1000:9999"

 +3        SET DIR("A")="FISCAL YEAR OF FUNDS"

 +4        SET DIR("B")=$SELECT($EXTRACT(DT,4,5)<10:$EXTRACT(DT,1,3)+1700,1:($EXTRACT(DT,1,3)+1)+1700)

 +5        DO DIR^ACRFDIC

 +6        IF X["^"

               SET ACROUT=""

               QUIT 

 +7        IF $LENGTH(Y)'=4

               WRITE !!,"FISCAL YEAR OF FUNDS REQUIRED",!

               GOTO FYFUN

 +8        SET ACRFYFUN=Y

 +9        SET $PIECE(ACRLBDT,U)=ACRFYFUN

 +10       QUIT