IB20P74P ;ALB/MAF - POST INIT FOR PATCH IB*2.0*74 ; 28-MAR-00
;;2.0;INTEGRATED BILLING;**74**; 21-MAR-94
;
;
EN ;This code sets up the variables and calls the routine to print
;or print and update the exemption status. XPDQUES variables
;set in the pre-install are used.
;
;
Q:'$D(^IBA(354.1,"APRIOR",2981201)) ; quit if the "APRIOR" x-ref is not set for 12/1/98.
N %,IBACT,IBBMES,IBPR,IBPRDT,X,ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSK
S IBACT=$G(XPDQUES("POS1")),IBACT=$S(IBACT="U":3,1:2)
S ZTIO=$G(XPDQUES("POS2"))
D NOW^%DTC S ZTDTH=%
;
; -- check to see if prior year thresholds used
;
S IBPR=$P($G(^IBE(354.3,0)),"^",3) I IBPR="" Q
S IBPR=$P(^IBE(354.3,IBPR,0),"^")
S X=$S($E($P(IBPR,"^"),1,3)>296:1,1:2) S IBPRDT=$O(^IBE(354.3,"AIVDT",X,-($P(IBPR,"^")))) ;threshold prior to the one entered
I IBPRDT<0 S IBPRDT=-IBPRDT ; invert negative number
; Queuing job.
S IBBMES=$S(IBACT=3:"& UPDATE ",1:"") D BMES^XPDUTL(" >>>Queuing the PRINT "_IBBMES_"job to run NOW")
S IO("Q")="",ZTRTN="DQ^IBARXET",ZTDESC="IB PRIOR YEAR THRESHOLD PRINT"_$S(IBACT=3:" AND UPDATE",1:""),ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q")
S IBBMES=$S($D(ZTSK):"This job has been queued for NOW, as task number "_ZTSK_".",1:"This job could not be queued. Please edit the 12/1/99 threshold through the 'Add Income Thresholds' option, which allows you to queue this job.")
D BMES^XPDUTL(" >>>"_IBBMES)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P74P 1411 printed Dec 13, 2024@02:04:48 Page 2
IB20P74P ;ALB/MAF - POST INIT FOR PATCH IB*2.0*74 ; 28-MAR-00
+1 ;;2.0;INTEGRATED BILLING;**74**; 21-MAR-94
+2 ;
+3 ;
EN ;This code sets up the variables and calls the routine to print
+1 ;or print and update the exemption status. XPDQUES variables
+2 ;set in the pre-install are used.
+3 ;
+4 ;
+5 ; quit if the "APRIOR" x-ref is not set for 12/1/98.
if '$DATA(^IBA(354.1,"APRIOR",2981201))
QUIT
+6 NEW %,IBACT,IBBMES,IBPR,IBPRDT,X,ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSK
+7 SET IBACT=$GET(XPDQUES("POS1"))
SET IBACT=$SELECT(IBACT="U":3,1:2)
+8 SET ZTIO=$GET(XPDQUES("POS2"))
+9 DO NOW^%DTC
SET ZTDTH=%
+10 ;
+11 ; -- check to see if prior year thresholds used
+12 ;
+13 SET IBPR=$PIECE($GET(^IBE(354.3,0)),"^",3)
IF IBPR=""
QUIT
+14 SET IBPR=$PIECE(^IBE(354.3,IBPR,0),"^")
+15 ;threshold prior to the one entered
SET X=$SELECT($EXTRACT($PIECE(IBPR,"^"),1,3)>296:1,1:2)
SET IBPRDT=$ORDER(^IBE(354.3,"AIVDT",X,-($PIECE(IBPR,"^"))))
+16 ; invert negative number
IF IBPRDT<0
SET IBPRDT=-IBPRDT
+17 ; Queuing job.
+18 SET IBBMES=$SELECT(IBACT=3:"& UPDATE ",1:"")
DO BMES^XPDUTL(" >>>Queuing the PRINT "_IBBMES_"job to run NOW")
+19 SET IO("Q")=""
SET ZTRTN="DQ^IBARXET"
SET ZTDESC="IB PRIOR YEAR THRESHOLD PRINT"_$SELECT(IBACT=3:" AND UPDATE",1:"")
SET ZTSAVE("IB*")=""
DO ^%ZTLOAD
KILL IO("Q")
+20 SET IBBMES=$SELECT($DATA(ZTSK):"This job has been queued for NOW, as task number "_ZTSK_".",1:"This job could not be queued. Please edit the 12/1/99 threshold through the 'Add Income Thresholds' option, which allows you to queue this job.")
+21 DO BMES^XPDUTL(" >>>"_IBBMES)
+22 QUIT
