- 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
