IB20P203 ;DSI/ESG - CANCEL CLAIM BUG FIX ;17-OCT-2002
;;2.0;INTEGRATED BILLING;**203**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; The purpose of this routine is to correctly "cancel" bills on the
; ClaimsManager server that have been cancelled in VistA. A bill is
; considered cancelled in ClaimsManager when all of it's line items
; have a status of deleted.
;
EN ;
NEW IBIFN,IBSTAT,CMDATA,TIFLAG,IBCISNT,IBCISTAT,IBCIREDT,IBCIERR,OK
NEW IBCIPBCT,IBCISOCK
;
; Make sure the site is using ClaimsManager
I '$$CK0^IBCIUT1() G EXIT
;
; If we're in the TEST account, use different ports
I $$ENV^IBCIUT5="T" D
. NEW PORT,DA,DIK,DIC,X,Y
. F PORT=10040,10050,10060 D
.. S DA=$O(^IBE(350.9,1,50.06,"B",PORT,"")) Q:'DA
.. S DA(1)=1,DIK="^IBE(350.9,1,50.06,"
.. D ^DIK
.. Q
. Q
;
; This initial loop is just to count how many bills will be sent
; to ClaimsManager.
;
I '$D(ZTQUEUED) W !,"Counting eligible bills ... "
S IBIFN=0,IBCIPBCT=0
F S IBIFN=$O(^IBA(351.9,IBIFN)) Q:'IBIFN D
. S IBSTAT=$P($G(^DGCR(399,IBIFN,0)),U,13) ; IB bill status
. I IBSTAT'=7 Q ; must be cancelled
. S CMDATA=$G(^IBA(351.9,IBIFN,0))
. I '$P(CMDATA,U,15) Q ; must have been sent to CM
. ;
. ; If the bill was last sent to CM before 3/27/02, then we're OK
. ; because the bug was not released until this date.
. I $P(CMDATA,U,3)<3020327 Q
. ;
. ; update count
. S IBCIPBCT=IBCIPBCT+1
. Q
;
I '$D(ZTQUEUED) D
. W "Done"
. W !!,"The number of cancelled bills that will be sent to ClaimsManager is ",IBCIPBCT,"."
. I 'IBCIPBCT Q
. W !!,"Note: Each ""."" below represents 10 bills."
. W !!,"Sending cancelled bills to ClaimsManager "
. Q
;
; This is the main processing loop.
;
S IBIFN=0,OK=1,IBCIPBCT=0
F S IBIFN=$O(^IBA(351.9,IBIFN)) Q:'IBIFN D I 'OK Q
. S IBSTAT=$P($G(^DGCR(399,IBIFN,0)),U,13) ; IB bill status
. I IBSTAT'=7 Q ; must be cancelled
. S CMDATA=$G(^IBA(351.9,IBIFN,0))
. I '$P(CMDATA,U,15) Q ; must have been sent to CM
. ;
. ; If the bill was last sent to CM before 3/27/02, then we're OK
. ; because the bug was not released until this date.
. I $P(CMDATA,U,3)<3020327 Q
. ;
. ; update count and display a "." every 10 bills
. S IBCIPBCT=IBCIPBCT+1
. I IBCIPBCT#10=0,'$D(ZTQUEUED) W "."
. ;
. ; temporary information flag; assume 3,4,5 nodes exist
. S TIFLAG=1
. I '$P($G(^IBA(351.9,IBIFN,3)),U,1) S TIFLAG=0 ; if they don't exist
. ;
. ; Process this bill and retrieve variable OK
. D PROCESS(IBIFN,.OK)
. ;
. ; remove the 3,4,5 nodes if they were not there before
. I 'TIFLAG D DELTI^IBCIUT4
. Q
;
I 'OK,'$D(ZTQUEUED) D
. W !!,"The post-install routine failed due to too many tcp/ip failures with 1 bill."
. W !,"Please check the error trap."
. W !,"This routine will now intentionally crash."
. W !!
. Q
;
I 'OK X "<BOOM>" ; intentional crash
;
I '$D(ZTQUEUED) W " Done"
;
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
;
PROCESS(IBIFN,OK) ; Procedure to process 1 bill
; IBIFN is passed in as the internal bill#
; OK is an output parameter to determine if we can proceed
;
NEW IBCIPECT,IBCIPZE
S IBCIPECT=0,IBCIPZE="" ; error variables
TRYAGN ;
D SEND(IBIFN) ; send to ClaimsManager
;
; Control comes here after error trap processing
; and stack levels are unwound
;
I IBCIPZE="" S OK=1 G PROCX ; no errors, we're OK
I IBCIPECT>5 S OK=0 G PROCX ; too many errors, we're done
HANG 2 ; pause in between sendings
G TRYAGN ; try again
PROCX ;
Q
;
;
SEND(IBIFN) ; Send one bill to ClaimsManager
NEW $ESTACK,$ETRAP
S $ETRAP="D ERRTRP^IB20P203"
S IBCISNT=4,IBCIPZE=""
D ST2^IBCIST
HANG 2
SENDX ;
Q
;
;
ERRTRP ; Error Trap processing
;
S IBCIPZE=$$EC^%ZOSV ; error message
DO CLOSE^%ZISTCP ; close the tcp/ip port
I $G(IBCISOCK) L -^IBCITCP(IBCISOCK) ; unlock the port
KILL ^TMP($J,"CMRESP2"),^TMP("IBCIMSG",$J) ; kill scratch globals
S IBCIPECT=IBCIPECT+1 ; error count for this bill
I IBCIPECT>5 D ^%ZTER ; log error if cascading
I '$D(ZTQUEUED) D
. W !!,"Error detected: ",IBCIPZE
. W !," Bill ID: ",$P($G(^DGCR(399,IBIFN,0)),U,1)
. W !," Error count: ",IBCIPECT
. Q
G UNWIND^%ZTER ; unwind stack levels
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P203 4632 printed Nov 22, 2024@17:11:55 Page 2
IB20P203 ;DSI/ESG - CANCEL CLAIM BUG FIX ;17-OCT-2002
+1 ;;2.0;INTEGRATED BILLING;**203**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; The purpose of this routine is to correctly "cancel" bills on the
+5 ; ClaimsManager server that have been cancelled in VistA. A bill is
+6 ; considered cancelled in ClaimsManager when all of it's line items
+7 ; have a status of deleted.
+8 ;
EN ;
+1 NEW IBIFN,IBSTAT,CMDATA,TIFLAG,IBCISNT,IBCISTAT,IBCIREDT,IBCIERR,OK
+2 NEW IBCIPBCT,IBCISOCK
+3 ;
+4 ; Make sure the site is using ClaimsManager
+5 IF '$$CK0^IBCIUT1()
GOTO EXIT
+6 ;
+7 ; If we're in the TEST account, use different ports
+8 IF $$ENV^IBCIUT5="T"
Begin DoDot:1
+9 NEW PORT,DA,DIK,DIC,X,Y
+10 FOR PORT=10040,10050,10060
Begin DoDot:2
+11 SET DA=$ORDER(^IBE(350.9,1,50.06,"B",PORT,""))
if 'DA
QUIT
+12 SET DA(1)=1
SET DIK="^IBE(350.9,1,50.06,"
+13 DO ^DIK
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 ;
+17 ; This initial loop is just to count how many bills will be sent
+18 ; to ClaimsManager.
+19 ;
+20 IF '$DATA(ZTQUEUED)
WRITE !,"Counting eligible bills ... "
+21 SET IBIFN=0
SET IBCIPBCT=0
+22 FOR
SET IBIFN=$ORDER(^IBA(351.9,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+23 ; IB bill status
SET IBSTAT=$PIECE($GET(^DGCR(399,IBIFN,0)),U,13)
+24 ; must be cancelled
IF IBSTAT'=7
QUIT
+25 SET CMDATA=$GET(^IBA(351.9,IBIFN,0))
+26 ; must have been sent to CM
IF '$PIECE(CMDATA,U,15)
QUIT
+27 ;
+28 ; If the bill was last sent to CM before 3/27/02, then we're OK
+29 ; because the bug was not released until this date.
+30 IF $PIECE(CMDATA,U,3)<3020327
QUIT
+31 ;
+32 ; update count
+33 SET IBCIPBCT=IBCIPBCT+1
+34 QUIT
End DoDot:1
+35 ;
+36 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+37 WRITE "Done"
+38 WRITE !!,"The number of cancelled bills that will be sent to ClaimsManager is ",IBCIPBCT,"."
+39 IF 'IBCIPBCT
QUIT
+40 WRITE !!,"Note: Each ""."" below represents 10 bills."
+41 WRITE !!,"Sending cancelled bills to ClaimsManager "
+42 QUIT
End DoDot:1
+43 ;
+44 ; This is the main processing loop.
+45 ;
+46 SET IBIFN=0
SET OK=1
SET IBCIPBCT=0
+47 FOR
SET IBIFN=$ORDER(^IBA(351.9,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+48 ; IB bill status
SET IBSTAT=$PIECE($GET(^DGCR(399,IBIFN,0)),U,13)
+49 ; must be cancelled
IF IBSTAT'=7
QUIT
+50 SET CMDATA=$GET(^IBA(351.9,IBIFN,0))
+51 ; must have been sent to CM
IF '$PIECE(CMDATA,U,15)
QUIT
+52 ;
+53 ; If the bill was last sent to CM before 3/27/02, then we're OK
+54 ; because the bug was not released until this date.
+55 IF $PIECE(CMDATA,U,3)<3020327
QUIT
+56 ;
+57 ; update count and display a "." every 10 bills
+58 SET IBCIPBCT=IBCIPBCT+1
+59 IF IBCIPBCT#10=0
IF '$DATA(ZTQUEUED)
WRITE "."
+60 ;
+61 ; temporary information flag; assume 3,4,5 nodes exist
+62 SET TIFLAG=1
+63 ; if they don't exist
IF '$PIECE($GET(^IBA(351.9,IBIFN,3)),U,1)
SET TIFLAG=0
+64 ;
+65 ; Process this bill and retrieve variable OK
+66 DO PROCESS(IBIFN,.OK)
+67 ;
+68 ; remove the 3,4,5 nodes if they were not there before
+69 IF 'TIFLAG
DO DELTI^IBCIUT4
+70 QUIT
End DoDot:1
IF 'OK
QUIT
+71 ;
+72 IF 'OK
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+73 WRITE !!,"The post-install routine failed due to too many tcp/ip failures with 1 bill."
+74 WRITE !,"Please check the error trap."
+75 WRITE !,"This routine will now intentionally crash."
+76 WRITE !!
+77 QUIT
End DoDot:1
+78 ;
+79 ; intentional crash
IF 'OK
XECUTE "<BOOM>"
+80 ;
+81 IF '$DATA(ZTQUEUED)
WRITE " Done"
+82 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
+3 ;
+4 ;
PROCESS(IBIFN,OK) ; Procedure to process 1 bill
+1 ; IBIFN is passed in as the internal bill#
+2 ; OK is an output parameter to determine if we can proceed
+3 ;
+4 NEW IBCIPECT,IBCIPZE
+5 ; error variables
SET IBCIPECT=0
SET IBCIPZE=""
TRYAGN ;
+1 ; send to ClaimsManager
DO SEND(IBIFN)
+2 ;
+3 ; Control comes here after error trap processing
+4 ; and stack levels are unwound
+5 ;
+6 ; no errors, we're OK
IF IBCIPZE=""
SET OK=1
GOTO PROCX
+7 ; too many errors, we're done
IF IBCIPECT>5
SET OK=0
GOTO PROCX
+8 ; pause in between sendings
HANG 2
+9 ; try again
GOTO TRYAGN
PROCX ;
+1 QUIT
+2 ;
+3 ;
SEND(IBIFN) ; Send one bill to ClaimsManager
+1 NEW $ESTACK,$ETRAP
+2 SET $ETRAP="D ERRTRP^IB20P203"
+3 SET IBCISNT=4
SET IBCIPZE=""
+4 DO ST2^IBCIST
+5 HANG 2
SENDX ;
+1 QUIT
+2 ;
+3 ;
ERRTRP ; Error Trap processing
+1 ;
+2 ; error message
SET IBCIPZE=$$EC^%ZOSV
+3 ; close the tcp/ip port
DO CLOSE^%ZISTCP
+4 ; unlock the port
IF $GET(IBCISOCK)
LOCK -^IBCITCP(IBCISOCK)
+5 ; kill scratch globals
KILL ^TMP($JOB,"CMRESP2"),^TMP("IBCIMSG",$JOB)
+6 ; error count for this bill
SET IBCIPECT=IBCIPECT+1
+7 ; log error if cascading
IF IBCIPECT>5
DO ^%ZTER
+8 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+9 WRITE !!,"Error detected: ",IBCIPZE
+10 WRITE !," Bill ID: ",$PIECE($GET(^DGCR(399,IBIFN,0)),U,1)
+11 WRITE !," Error count: ",IBCIPECT
+12 QUIT
End DoDot:1
+13 ; unwind stack levels
GOTO UNWIND^%ZTER
+14 ;
