IB20P74P.m

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 ---IB20P74P   1411     printed  Apr 09, 2024@21:33:55                                                                                                                                                                                                    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