IBECUS1 ;RLM/DVAMC - TRICARE PHARMACY BILLING ENGINES ; 14-AUG-96
;;2.0;INTEGRATED BILLING;**52,88,240,274**;21-MAR-94
;
BILLS ; Tasked entry point: Secondary Billing engine.
;
I $D(^%ZOSF("TRAP")) S X="ERRS^IBECUS1",@^("TRAP")
;
; - main idling loop
F H 100 Q:'$P($G(^IBE(350.9,1,9)),"^",4)
;
I $P($G(^IBE(350.9,1,9)),"^",10) S $P(^IBE(350.9,1,9),"^",5)="" G BILLQ
;
; - drop into Primary Billing task...
;
;
BILLP ; Tasked entry point: Primary Billing engine.
;
I $D(^%ZOSF("TRAP")) S X="ERRP^IBECUS1",@^("TRAP")
;
; - open the port
D CALL^%ZISTCP(IBCHAN,IBBPORT) I POP G BILLC
;
; - start secondary job
D SECB
;
; - send alert notifying that the billing engine has started
D NOW^%DTC S $P(^IBE(350.9,1,9),"^",8)=%,Y=% X ^DD("DD")
S XQA("G.IB CHAMP RX START")="",XQAMSG="IPS Billing Process Started "_Y
D SETUP^XQALERT
;
; - main processing loop
F R IBX:50 D SND,UPD I $P($G(^IBE(350.9,1,9)),"^",10) Q
;
BILLC D CLOSE^%ZISTCP
;
; - delete the primary task
S $P(^IBE(350.9,1,9),"^",4)=""
;
BILLQ Q
;
;
SND ; Process all prescriptions queued for billing.
F R *IBI:0 Q:IBI=-1 ; bleed queue
S IBKEY="" F S IBKEY=$O(^IBA(351.5,"APOST",IBKEY)) Q:'IBKEY S IBKEYD=$G(^(IBKEY)),IBROU="^IBECUS"_$S(IBKEYD["REVERSE":3,1:2) D @IBROU
Q
;
;
UPD ; Update the last run date/time.
D NOW^%DTC
S $P(^IBE(350.9,1,9),"^",9)=%
Q
;
;
ERRP ; Primary billing task error trap
D CLOSE^%ZISTCP
S $P(^IBE(350.9,1,9),"^",4)=""
G ^%ZTER
;
ERRS ; Secondary billing task error trap
D SECB
G ^%ZTER
;
SECB ; Start the secondary billing task.
S ZTRTN="BILLS^IBECUS1",ZTDTH=$H,ZTIO=""
S ZTDESC="IB - TRICARE Secondary Billing Task"
I IBVOL]"" S ZTCPU=IBVOL
F I="IBBPORT","IBCHAN","IBCHSET","IBPRESCR","IBVOL" S ZTSAVE(I)=""
D ^%ZTLOAD
;
S $P(^IBE(350.9,1,9),"^",5)=$G(ZTSK)
;
K ZTRTN,ZTDTH,ZTIO,ZTSK,ZTCPU,ZTSAVE
Q
;
;
;
AWPS ; Tasked entry point: Secondary AWP Update engine.
;
I $D(^%ZOSF("TRAP")) S X="ERRAS^IBECUS1",@^("TRAP")
;
; - main idling loop
F H 100 Q:'$P($G(^IBE(350.9,1,9)),"^",6)
;
I $P($G(^IBE(350.9,1,9)),"^",10) S $P(^IBE(350.9,1,9),"^",7)="" G AWPPQ
;
; - drop into Primary AWP Update task...
;
;
AWPP ; Tasked Entry Point: Primary AWP Update Engine
;
I $D(^%ZOSF("TRAP")) S X="ERRAP^IBECUS1",@^("TRAP")
;
; - open the port
D CALL^%ZISTCP(IBCHAN,IBAPORT) I POP G AWPPC
;
; - start secondary job
D SECA
;
; - main processing loop
S IBUPD=0 F R IBX:30 D I $P($G(^IBE(350.9,1,9)),"^",10) Q
.;
.; - if no response, sent alert if necessary
.I IBX="" D:IBUPD Q
..D NOW^%DTC S Y=% X ^DD("DD")
..S XQA("G.IB CHAMP RX START")=""
..S XQAMSG="AWP update completed on "_Y_". "_IBUPD_" new rates were added."
..D SETUP^XQALERT
..S IBUPD=0
.;
.; - respond if record is not in the anticipated format
.I IBX'?36N W "N" Q
.I IBX?36"9" Q
.;
.; - pull data from the transmitted record
.S IBNDCO=$E(IBX,1,11),IBNDCN=$E(IBX,12,22),IBAWP=$E(IBX,23,29)
.S IBAWP=$E(IBAWP,1,3)_"."_$E(IBAWP,4,7)
.S IBNDC=$S(IBNDCN:IBNDCN,1:IBNDCO)
.S IBNDC=$E(IBNDC,1,5)_"-"_$E(IBNDC,6,9)_"-"_$E(IBNDC,10,11)
.;
.; - find/build billable item and file the new charge item
.N DIQUIET S DIQUIET=1,IBG=0 D DT^DICRW
.S IBITEM=+$$ADDBI^IBCREF("NDC",IBNDC)
.I IBITEM,$$ADDCI^IBCREF(IBCHSET,IBITEM,DT,IBAWP) S IBG=1
.;
.; - respond and update the counter
.W "Y",!
.S:IBG IBUPD=IBUPD+1
;
AWPPC D CLOSE^%ZISTCP
;
; - delete the primary task
S $P(^IBE(350.9,1,9),"^",6)=""
;
AWPPQ Q
;
;
SECA ; Start the secondary AWP Update task.
S ZTRTN="AWPS^IBECUS1",ZTDTH=$H,ZTIO=""
S ZTDESC="IB - TRICARE Secondary AWP Update Task"
I IBVOL]"" S ZTCPU=IBVOL
F I="IBAPORT","IBCHAN","IBCHSET","IBVOL" S ZTSAVE(I)=""
D ^%ZTLOAD
;
S $P(^IBE(350.9,1,9),"^",7)=$G(ZTSK)
;
K ZTRTN,ZTDTH,ZTIO,ZTSK,ZTCPU,ZTSAVE
Q
;
ERRAP ; Primary billing task error trap
D CLOSE^%ZISTCP
S $P(^IBE(350.9,1,9),"^",6)=""
G ^%ZTER
;
ERRAS ; Secondary billing task error trap
D SECA
G ^%ZTER
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECUS1 4094 printed Dec 13, 2024@02:21:45 Page 2
IBECUS1 ;RLM/DVAMC - TRICARE PHARMACY BILLING ENGINES ; 14-AUG-96
+1 ;;2.0;INTEGRATED BILLING;**52,88,240,274**;21-MAR-94
+2 ;
BILLS ; Tasked entry point: Secondary Billing engine.
+1 ;
+2 IF $DATA(^%ZOSF("TRAP"))
SET X="ERRS^IBECUS1"
SET @^("TRAP")
+3 ;
+4 ; - main idling loop
+5 FOR
HANG 100
if '$PIECE($GET(^IBE(350.9,1,9)),"^",4)
QUIT
+6 ;
+7 IF $PIECE($GET(^IBE(350.9,1,9)),"^",10)
SET $PIECE(^IBE(350.9,1,9),"^",5)=""
GOTO BILLQ
+8 ;
+9 ; - drop into Primary Billing task...
+10 ;
+11 ;
BILLP ; Tasked entry point: Primary Billing engine.
+1 ;
+2 IF $DATA(^%ZOSF("TRAP"))
SET X="ERRP^IBECUS1"
SET @^("TRAP")
+3 ;
+4 ; - open the port
+5 DO CALL^%ZISTCP(IBCHAN,IBBPORT)
IF POP
GOTO BILLC
+6 ;
+7 ; - start secondary job
+8 DO SECB
+9 ;
+10 ; - send alert notifying that the billing engine has started
+11 DO NOW^%DTC
SET $PIECE(^IBE(350.9,1,9),"^",8)=%
SET Y=%
XECUTE ^DD("DD")
+12 SET XQA("G.IB CHAMP RX START")=""
SET XQAMSG="IPS Billing Process Started "_Y
+13 DO SETUP^XQALERT
+14 ;
+15 ; - main processing loop
+16 FOR
READ IBX:50
DO SND
DO UPD
IF $PIECE($GET(^IBE(350.9,1,9)),"^",10)
QUIT
+17 ;
BILLC DO CLOSE^%ZISTCP
+1 ;
+2 ; - delete the primary task
+3 SET $PIECE(^IBE(350.9,1,9),"^",4)=""
+4 ;
BILLQ QUIT
+1 ;
+2 ;
SND ; Process all prescriptions queued for billing.
+1 ; bleed queue
FOR
READ *IBI:0
if IBI=-1
QUIT
+2 SET IBKEY=""
FOR
SET IBKEY=$ORDER(^IBA(351.5,"APOST",IBKEY))
if 'IBKEY
QUIT
SET IBKEYD=$GET(^(IBKEY))
SET IBROU="^IBECUS"_$SELECT(IBKEYD["REVERSE":3,1:2)
DO @IBROU
+3 QUIT
+4 ;
+5 ;
UPD ; Update the last run date/time.
+1 DO NOW^%DTC
+2 SET $PIECE(^IBE(350.9,1,9),"^",9)=%
+3 QUIT
+4 ;
+5 ;
ERRP ; Primary billing task error trap
+1 DO CLOSE^%ZISTCP
+2 SET $PIECE(^IBE(350.9,1,9),"^",4)=""
+3 GOTO ^%ZTER
+4 ;
ERRS ; Secondary billing task error trap
+1 DO SECB
+2 GOTO ^%ZTER
+3 ;
SECB ; Start the secondary billing task.
+1 SET ZTRTN="BILLS^IBECUS1"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+2 SET ZTDESC="IB - TRICARE Secondary Billing Task"
+3 IF IBVOL]""
SET ZTCPU=IBVOL
+4 FOR I="IBBPORT","IBCHAN","IBCHSET","IBPRESCR","IBVOL"
SET ZTSAVE(I)=""
+5 DO ^%ZTLOAD
+6 ;
+7 SET $PIECE(^IBE(350.9,1,9),"^",5)=$GET(ZTSK)
+8 ;
+9 KILL ZTRTN,ZTDTH,ZTIO,ZTSK,ZTCPU,ZTSAVE
+10 QUIT
+11 ;
+12 ;
+13 ;
AWPS ; Tasked entry point: Secondary AWP Update engine.
+1 ;
+2 IF $DATA(^%ZOSF("TRAP"))
SET X="ERRAS^IBECUS1"
SET @^("TRAP")
+3 ;
+4 ; - main idling loop
+5 FOR
HANG 100
if '$PIECE($GET(^IBE(350.9,1,9)),"^",6)
QUIT
+6 ;
+7 IF $PIECE($GET(^IBE(350.9,1,9)),"^",10)
SET $PIECE(^IBE(350.9,1,9),"^",7)=""
GOTO AWPPQ
+8 ;
+9 ; - drop into Primary AWP Update task...
+10 ;
+11 ;
AWPP ; Tasked Entry Point: Primary AWP Update Engine
+1 ;
+2 IF $DATA(^%ZOSF("TRAP"))
SET X="ERRAP^IBECUS1"
SET @^("TRAP")
+3 ;
+4 ; - open the port
+5 DO CALL^%ZISTCP(IBCHAN,IBAPORT)
IF POP
GOTO AWPPC
+6 ;
+7 ; - start secondary job
+8 DO SECA
+9 ;
+10 ; - main processing loop
+11 SET IBUPD=0
FOR
READ IBX:30
Begin DoDot:1
+12 ;
+13 ; - if no response, sent alert if necessary
+14 IF IBX=""
if IBUPD
Begin DoDot:2
+15 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+16 SET XQA("G.IB CHAMP RX START")=""
+17 SET XQAMSG="AWP update completed on "_Y_". "_IBUPD_" new rates were added."
+18 DO SETUP^XQALERT
+19 SET IBUPD=0
End DoDot:2
QUIT
+20 ;
+21 ; - respond if record is not in the anticipated format
+22 IF IBX'?36N
WRITE "N"
QUIT
+23 IF IBX?36"9"
QUIT
+24 ;
+25 ; - pull data from the transmitted record
+26 SET IBNDCO=$EXTRACT(IBX,1,11)
SET IBNDCN=$EXTRACT(IBX,12,22)
SET IBAWP=$EXTRACT(IBX,23,29)
+27 SET IBAWP=$EXTRACT(IBAWP,1,3)_"."_$EXTRACT(IBAWP,4,7)
+28 SET IBNDC=$SELECT(IBNDCN:IBNDCN,1:IBNDCO)
+29 SET IBNDC=$EXTRACT(IBNDC,1,5)_"-"_$EXTRACT(IBNDC,6,9)_"-"_$EXTRACT(IBNDC,10,11)
+30 ;
+31 ; - find/build billable item and file the new charge item
+32 NEW DIQUIET
SET DIQUIET=1
SET IBG=0
DO DT^DICRW
+33 SET IBITEM=+$$ADDBI^IBCREF("NDC",IBNDC)
+34 IF IBITEM
IF $$ADDCI^IBCREF(IBCHSET,IBITEM,DT,IBAWP)
SET IBG=1
+35 ;
+36 ; - respond and update the counter
+37 WRITE "Y",!
+38 if IBG
SET IBUPD=IBUPD+1
End DoDot:1
IF $PIECE($GET(^IBE(350.9,1,9)),"^",10)
QUIT
+39 ;
AWPPC DO CLOSE^%ZISTCP
+1 ;
+2 ; - delete the primary task
+3 SET $PIECE(^IBE(350.9,1,9),"^",6)=""
+4 ;
AWPPQ QUIT
+1 ;
+2 ;
SECA ; Start the secondary AWP Update task.
+1 SET ZTRTN="AWPS^IBECUS1"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+2 SET ZTDESC="IB - TRICARE Secondary AWP Update Task"
+3 IF IBVOL]""
SET ZTCPU=IBVOL
+4 FOR I="IBAPORT","IBCHAN","IBCHSET","IBVOL"
SET ZTSAVE(I)=""
+5 DO ^%ZTLOAD
+6 ;
+7 SET $PIECE(^IBE(350.9,1,9),"^",7)=$GET(ZTSK)
+8 ;
+9 KILL ZTRTN,ZTDTH,ZTIO,ZTSK,ZTCPU,ZTSAVE
+10 QUIT
+11 ;
ERRAP ; Primary billing task error trap
+1 DO CLOSE^%ZISTCP
+2 SET $PIECE(^IBE(350.9,1,9),"^",6)=""
+3 GOTO ^%ZTER
+4 ;
ERRAS ; Secondary billing task error trap
+1 DO SECA
+2 GOTO ^%ZTER
