ACRFPAYS ;IHS/OIRM/DSD/AEF - ASSIGN TREASURY SCHEDULE NUMBER; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;
SCHNO(ACRFYDA,ACRBATDA,ACRSNO,ACRQUIT) ;EP
;----- ASSIGN TREASURY SCHEDULE NUMBER
;
; ACRFYDA = BATCH FISCAL YEAR IEN
; ACRBATDA = BATCH IEN
;
N ACRAP,ACRAPDA,ACRFY,ACRSDFY
K ACRSNO
D SCHCHK^ACRFPAY6
Q:$G(ACRSNO(1))]""!$D(ACRQUIT)!$D(ACROUT)
;
D AP(.Y)
I +Y'>0 S ACRQUIT="" Q
S ACRAPDA=+Y
S ACRAP=$P($G(^AUTTACPT(+ACRAPDA,0)),U)
;
S ACRFY=$P($G(^AFSLAFP(ACRFYDA,0)),U)
D SCHFY(ACRFY,.Y)
Q:+Y'>0
S ACRSDFY=+Y
;
D SCHAP(ACRSDFY,ACRAPDA,.Y)
Q:+Y'>0
S ACRAPDA=+Y ;CHANGED TO SYS DEFAULTS AP IEN
;
D NXTSCH(ACRFYDA,ACRSDFY,ACRAPDA,ACRAP,.ACRSNO,.ACRQUIT)
Q
AP(Y) ;----- SELECT ACCOUNTING POINT
;
N DIC,DTOUT,DUOUT,X
S DIC="^AUTTACPT("
S DIC(0)="AEMQZ"
S DIC("A")="Which ACCOUNTING POINT: "
I $P($G(^ACRSYS(1,"DT1")),U,13) S DIC("B")=$P($G(^("DT1")),U,13)
D ^DIC
Q
SCHFY(ACRFY,Y) ;
;----- LOOKUP/ADD FISCAL YEAR IN SCHEDULE NUMBER SUBFILE OF FMS SYSTEM
; DEFAULTS FILE
;
N DA,DIC,DLAYGO,X
S Y=$O(^ACRSYS(1,50,"B",ACRFY,0))
Q:+Y>0
S DA(1)=1
S DIC="^ACRSYS("_DA(1)_",50,"
S DIC(0)="L"
S DIC("P")=$P(^DD(9002199.2,5001,0),U,2)
S DLAYGO=9002199.2
S X=ACRFY
K DD,DO
D FILE^DICN
Q
SCHAP(ACRFYDA,ACRAPDA,Y) ;
;----- LOOKUP/ADD ACCOUNTING POINT IN SCHEDULE NUMBER SUBFILE OF FISCAL
; YEAR SUBFILE OF FMS SYSTEM DEFAULTS FILE
;
N DA,DIC,DLAYGO,X
S Y=$O(^ACRSYS(1,50,ACRFYDA,1,"B",ACRAPDA,0))
Q:+Y>0
S DA(2)=1
S DA(1)=ACRFYDA
S DIC="^ACRSYS("_DA(2)_",50,"_DA(1)_",1,"
S DIC(0)="L"
S DIC("P")=$P(^DD(9002199.251,1,0),U,2)
S DLAYGO=9002199.251
S DIC("DR")="1////3000"
S X=ACRAPDA
K DD,DO
D FILE^DICN
Q
NXTSCH(ACRFYDA,ACRSDFY,ACRAPDA,ACRAP,ACRSNO,ACRQUIT) ;
;----- GETS/UPDATES NEXT SCHEDULE NUMBER
;
N ACRFY,DIE,DIR,DR,X,Y
L +^ACRSYS(1,50,ACRSDFY,1,ACRAPDA,0):4
S ACRFY=$P($G(^ACRSYS(1,50,ACRSDFY,0)),U)
S ACRSNO=$P($G(^ACRSYS(1,50,ACRSDFY,1,ACRAPDA,0)),U,2)
F S ACRSNO=ACRSNO+1 Q:'$D(^AFSLAFP("M",ACRFY_ACRAP_ACRSNO,ACRFYDA))
S ACRSNO(1)=ACRFY_ACRAP_ACRSNO
W !!,"The next SCHEDULE NUMBER will be ",@ACRON,ACRSNO(1),@ACROF
S DIR(0)="YO"
S DIR("A")="Is this correct"
S DIR("B")="NO"
D ^DIR
I 'Y K ACRSNO S ACRQUIT="" L -^ACRSYS(1,50,ACRSDFY,1,ACRAPDA,0) Q
S DA(2)=1
S DA(1)=ACRSDFY
S DA=ACRAPDA
S DIE="^ACRSYS("_DA(2)_",50,"_DA(1)_",1,"
S DR="1////"_+ACRSNO
D ^DIE
L -^ACRSYS(1,50,ACRSDFY,1,ACRAPDA,0)
Q
ACRFPAYS ;IHS/OIRM/DSD/AEF - ASSIGN TREASURY SCHEDULE NUMBER; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;
SCHNO(ACRFYDA,ACRBATDA,ACRSNO,ACRQUIT) ;EP
+1 ;----- ASSIGN TREASURY SCHEDULE NUMBER
+2 ;
+3 ; ACRFYDA = BATCH FISCAL YEAR IEN
+4 ; ACRBATDA = BATCH IEN
+5 ;
+6 NEW ACRAP,ACRAPDA,ACRFY,ACRSDFY
+7 KILL ACRSNO
+8 DO SCHCHK^ACRFPAY6
+9 IF $GET(ACRSNO(1))]""!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+10 ;
+11 DO AP(.Y)
+12 IF +Y'>0
SET ACRQUIT=""
QUIT
+13 SET ACRAPDA=+Y
+14 SET ACRAP=$PIECE($GET(^AUTTACPT(+ACRAPDA,0)),U)
+15 ;
+16 SET ACRFY=$PIECE($GET(^AFSLAFP(ACRFYDA,0)),U)
+17 DO SCHFY(ACRFY,.Y)
+18 IF +Y'>0
QUIT
+19 SET ACRSDFY=+Y
+20 ;
+21 DO SCHAP(ACRSDFY,ACRAPDA,.Y)
+22 IF +Y'>0
QUIT
+23 ;CHANGED TO SYS DEFAULTS AP IEN
SET ACRAPDA=+Y
+24 ;
+25 DO NXTSCH(ACRFYDA,ACRSDFY,ACRAPDA,ACRAP,.ACRSNO,.ACRQUIT)
+26 QUIT
AP(Y) ;----- SELECT ACCOUNTING POINT
+1 ;
+2 NEW DIC,DTOUT,DUOUT,X
+3 SET DIC="^AUTTACPT("
+4 SET DIC(0)="AEMQZ"
+5 SET DIC("A")="Which ACCOUNTING POINT: "
+6 IF $PIECE($GET(^ACRSYS(1,"DT1")),U,13)
SET DIC("B")=$PIECE($GET(^("DT1")),U,13)
+7 DO ^DIC
+8 QUIT
SCHFY(ACRFY,Y) ;
+1 ;----- LOOKUP/ADD FISCAL YEAR IN SCHEDULE NUMBER SUBFILE OF FMS SYSTEM
+2 ; DEFAULTS FILE
+3 ;
+4 NEW DA,DIC,DLAYGO,X
+5 SET Y=$ORDER(^ACRSYS(1,50,"B",ACRFY,0))
+6 IF +Y>0
QUIT
+7 SET DA(1)=1
+8 SET DIC="^ACRSYS("_DA(1)_",50,"
+9 SET DIC(0)="L"
+10 SET DIC("P")=$PIECE(^DD(9002199.2,5001,0),U,2)
+11 SET DLAYGO=9002199.2
+12 SET X=ACRFY
+13 KILL DD,DO
+14 DO FILE^DICN
+15 QUIT
SCHAP(ACRFYDA,ACRAPDA,Y) ;
+1 ;----- LOOKUP/ADD ACCOUNTING POINT IN SCHEDULE NUMBER SUBFILE OF FISCAL
+2 ; YEAR SUBFILE OF FMS SYSTEM DEFAULTS FILE
+3 ;
+4 NEW DA,DIC,DLAYGO,X
+5 SET Y=$ORDER(^ACRSYS(1,50,ACRFYDA,1,"B",ACRAPDA,0))
+6 IF +Y>0
QUIT
+7 SET DA(2)=1
+8 SET DA(1)=ACRFYDA
+9 SET DIC="^ACRSYS("_DA(2)_",50,"_DA(1)_",1,"
+10 SET DIC(0)="L"
+11 SET DIC("P")=$PIECE(^DD(9002199.251,1,0),U,2)
+12 SET DLAYGO=9002199.251
+13 SET DIC("DR")="1////3000"
+14 SET X=ACRAPDA
+15 KILL DD,DO
+16 DO FILE^DICN
+17 QUIT
NXTSCH(ACRFYDA,ACRSDFY,ACRAPDA,ACRAP,ACRSNO,ACRQUIT) ;
+1 ;----- GETS/UPDATES NEXT SCHEDULE NUMBER
+2 ;
+3 NEW ACRFY,DIE,DIR,DR,X,Y
+4 LOCK +^ACRSYS(1,50,ACRSDFY,1,ACRAPDA,0):4
+5 SET ACRFY=$PIECE($GET(^ACRSYS(1,50,ACRSDFY,0)),U)
+6 SET ACRSNO=$PIECE($GET(^ACRSYS(1,50,ACRSDFY,1,ACRAPDA,0)),U,2)
+7 FOR
SET ACRSNO=ACRSNO+1
IF '$DATA(^AFSLAFP("M",ACRFY_ACRAP_ACRSNO,ACRFYDA))
QUIT
+8 SET ACRSNO(1)=ACRFY_ACRAP_ACRSNO
+9 WRITE !!,"The next SCHEDULE NUMBER will be ",@ACRON,ACRSNO(1),@ACROF
+10 SET DIR(0)="YO"
+11 SET DIR("A")="Is this correct"
+12 SET DIR("B")="NO"
+13 DO ^DIR
+14 IF 'Y
KILL ACRSNO
SET ACRQUIT=""
LOCK -^ACRSYS(1,50,ACRSDFY,1,ACRAPDA,0)
QUIT
+15 SET DA(2)=1
+16 SET DA(1)=ACRSDFY
+17 SET DA=ACRAPDA
+18 SET DIE="^ACRSYS("_DA(2)_",50,"_DA(1)_",1,"
+19 SET DR="1////"_+ACRSNO
+20 DO ^DIE
+21 LOCK -^ACRSYS(1,50,ACRSDFY,1,ACRAPDA,0)
+22 QUIT
