IBCE837ACCU3 ;EDE/JWS - DSS claim scrubber for ACC claims;
;;2.0;INTEGRATED BILLING;**770**;23-MAY-18;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;;SAC Exemption ID: 202411120708-06
;
; Reference to ENCODE^XLFJSON in ICR #6682
Q
;
CS(IBIFN) ;setup and call DSS claim scrubber
S $ZTRAP="ERR^IBCE837ACCU3"
N FT,AXY,IBTEMP,RESULT,IBSERVER,IBSERVICE,IBRESTOBJ,IBJSON,IBHEADER,IBRESPONSE,IBRESPERR,IBOUT,IBERRCD
N IBERRARR,IBRESP,IBHTTPRSP,IBOUTJSON,I,IBTOKEN,X
S FT=$$FT^IBCEF(IBIFN)
I FT=3 D EN^VEJDIBPY(.AXY,IBIFN)
I FT'=3 D EN^VEJDIBPX(.AXY,IBIFN)
;AXY="^TMP(""VEJDIBPI"",39469)"
;^TMP("VEJDIBPI",39469,2)="BGN ^~"
;^TMP("VEJDIBPI",39469,3)="GEN ^1^20240522^1^681^ENVOYP^759.0 D~"
;^TMP("VEJDIBPI",39469,4)="PRV ^^CHEYENNE VAMC^2360 E PERSHING BLVD^CHEYENNE^WY^"
;^TMP("VEJDIBPI",39469,5)="PRV1^87^2^^^^3819 Franklin,PO Box 2010^^Leavenworth^K"
;^TMP("VEJDIBPI",39469,6)="CI1 ^CIGNAZZZ^PO BOX 5905^SCRANTON^PA^185051234^^^^SU"
;^TMP("VEJDIBPI",39469,7)="CI1A^G5^0000^EI^830168494^G2^830168494^EI^DD67867886~"
;CONVERT TO JSON
M IBTEMP("ACC837",$J,"data")=^TMP("VEJDIBPI",$J)
S IBTEMP("ACC837",$J,"billIen")=""""_IBIFN_""""
D ENCODE^XLFJSON("IBTEMP(""ACC837"",$J)","RESULT") ;ICR #6682 (Supported)
;NOW SEND THIS BLOB TO WEB SERVICE
;PUT BLOB IN TMEP GOLBLA THEN PARSE LINE BU LINE AND WRITE IT TO THE OBJECT USING .WRITE METHOD
;EXAMPLE SNIPPET FROM ^DGAUDIT
S IBSERVER="IBACC VIRR SERVER"
S IBSERVICE="IBACC VIRR WEB SERVICE"
; get instance of client REST request object
S IBRESTOBJ=$$GETREST^XOBWLIB(IBSERVICE,IBSERVER) ;ICR #5421 (Supported)
S IBRESTOBJ.SSLCheckServerIdentity=0
;D IBDGRESTOBJ.EntityBody.Write("[")
F I=1:1 Q:'$D(RESULT(I)) S IBJSON=$G(IBJSON)_RESULT(I)
D IBRESTOBJ.EntityBody.Write(IBJSON)
;D IBDGRESTOBJ.EntityBody.Write("]")
S IBTOKEN=$$FIND1^DIC(364.991,,"X","ACCVIRRKEY")
;I IBTOKEN S IBTOKEN=$$GET1^DIQ(364.991,IBTOKEN_",",1)
I IBTOKEN S IBTOKEN=$$GET1^DIQ(364.991,IBTOKEN_",",.1) ;WCJ;V20;this needs to be field .1 not field 1
;
S IBHEADER="Authorization" D IBRESTOBJ.SetHeader(IBHEADER,IBTOKEN)
S IBHEADER="ContentType" D IBRESTOBJ.SetHeader(IBHEADER,"application/json")
;I $G(DOIT) S IBHEADER="Accept" D IBRESTOBJ.SetHeader(IBHEADER,"application/json")
S IBRESPONSE=$$POST^XOBWLIB(IBRESTOBJ,"",.IBRESPERR,0) ;ICR #5421 (Supported)
;I 'IBDGRESPONSE D Q IBDGOUT
;. S IBDGOUT=IBDGRESPONSE
;. S IBDGERRCD=$$ERRSPMSG^DGAUDIT1(IBDGRESPERR,.IBDGERRARR)
;. S IBDGOUT=0_"^"_$S($L(IBDGERRCD)>1:IBDGERRCD,1:$P(IBDGRESP,"^",2))
S IBHTTPRSP=IBRESTOBJ.HttpResponse
S IBOUTJSON=IBHTTPRSP.Data.ReadLine() ; reads json string response from the data stream.
; Decode json string DGOUTJSON and return by reference via DGOUT and quit
D DECODE^XLFJSON("IBOUTJSON","IBOUT") ;ICR #6682 (Supported)
;S IBDGOUT=1
;JWS;10/16/25;pass-failure flag in different location
S IBRESPONSE=$S($G(IBOUT("item","pass"))="true":1,1:0)
Q IBRESPONSE
;
ERR ;
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCE837ACCU3 3012 printed May 25, 2026@12:14:13 Page 2
IBCE837ACCU3 ;EDE/JWS - DSS claim scrubber for ACC claims;
+1 ;;2.0;INTEGRATED BILLING;**770**;23-MAY-18;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;SAC Exemption ID: 202411120708-06
+4 ;
+5 ; Reference to ENCODE^XLFJSON in ICR #6682
+6 QUIT
+7 ;
CS(IBIFN) ;setup and call DSS claim scrubber
+1 SET $ZTRAP="ERR^IBCE837ACCU3"
+2 NEW FT,AXY,IBTEMP,RESULT,IBSERVER,IBSERVICE,IBRESTOBJ,IBJSON,IBHEADER,IBRESPONSE,IBRESPERR,IBOUT,IBERRCD
+3 NEW IBERRARR,IBRESP,IBHTTPRSP,IBOUTJSON,I,IBTOKEN,X
+4 SET FT=$$FT^IBCEF(IBIFN)
+5 IF FT=3
DO EN^VEJDIBPY(.AXY,IBIFN)
+6 IF FT'=3
DO EN^VEJDIBPX(.AXY,IBIFN)
+7 ;AXY="^TMP(""VEJDIBPI"",39469)"
+8 ;^TMP("VEJDIBPI",39469,2)="BGN ^~"
+9 ;^TMP("VEJDIBPI",39469,3)="GEN ^1^20240522^1^681^ENVOYP^759.0 D~"
+10 ;^TMP("VEJDIBPI",39469,4)="PRV ^^CHEYENNE VAMC^2360 E PERSHING BLVD^CHEYENNE^WY^"
+11 ;^TMP("VEJDIBPI",39469,5)="PRV1^87^2^^^^3819 Franklin,PO Box 2010^^Leavenworth^K"
+12 ;^TMP("VEJDIBPI",39469,6)="CI1 ^CIGNAZZZ^PO BOX 5905^SCRANTON^PA^185051234^^^^SU"
+13 ;^TMP("VEJDIBPI",39469,7)="CI1A^G5^0000^EI^830168494^G2^830168494^EI^DD67867886~"
+14 ;CONVERT TO JSON
+15 MERGE IBTEMP("ACC837",$JOB,"data")=^TMP("VEJDIBPI",$JOB)
+16 SET IBTEMP("ACC837",$JOB,"billIen")=""""_IBIFN_""""
+17 ;ICR #6682 (Supported)
DO ENCODE^XLFJSON("IBTEMP(""ACC837"",$J)","RESULT")
+18 ;NOW SEND THIS BLOB TO WEB SERVICE
+19 ;PUT BLOB IN TMEP GOLBLA THEN PARSE LINE BU LINE AND WRITE IT TO THE OBJECT USING .WRITE METHOD
+20 ;EXAMPLE SNIPPET FROM ^DGAUDIT
+21 SET IBSERVER="IBACC VIRR SERVER"
+22 SET IBSERVICE="IBACC VIRR WEB SERVICE"
+23 ; get instance of client REST request object
+24 ;ICR #5421 (Supported)
SET IBRESTOBJ=$$GETREST^XOBWLIB(IBSERVICE,IBSERVER)
+25 SET IBRESTOBJ.SSLCheckServerIdentity=0
+26 ;D IBDGRESTOBJ.EntityBody.Write("[")
+27 FOR I=1:1
if '$DATA(RESULT(I))
QUIT
SET IBJSON=$GET(IBJSON)_RESULT(I)
+28 DO IBRESTOBJ.EntityBody.Write(IBJSON)
+29 ;D IBDGRESTOBJ.EntityBody.Write("]")
+30 SET IBTOKEN=$$FIND1^DIC(364.991,,"X","ACCVIRRKEY")
+31 ;I IBTOKEN S IBTOKEN=$$GET1^DIQ(364.991,IBTOKEN_",",1)
+32 ;WCJ;V20;this needs to be field .1 not field 1
IF IBTOKEN
SET IBTOKEN=$$GET1^DIQ(364.991,IBTOKEN_",",.1)
+33 ;
+34 SET IBHEADER="Authorization"
DO IBRESTOBJ.SetHeader(IBHEADER,IBTOKEN)
+35 SET IBHEADER="ContentType"
DO IBRESTOBJ.SetHeader(IBHEADER,"application/json")
+36 ;I $G(DOIT) S IBHEADER="Accept" D IBRESTOBJ.SetHeader(IBHEADER,"application/json")
+37 ;ICR #5421 (Supported)
SET IBRESPONSE=$$POST^XOBWLIB(IBRESTOBJ,"",.IBRESPERR,0)
+38 ;I 'IBDGRESPONSE D Q IBDGOUT
+39 ;. S IBDGOUT=IBDGRESPONSE
+40 ;. S IBDGERRCD=$$ERRSPMSG^DGAUDIT1(IBDGRESPERR,.IBDGERRARR)
+41 ;. S IBDGOUT=0_"^"_$S($L(IBDGERRCD)>1:IBDGERRCD,1:$P(IBDGRESP,"^",2))
+42 SET IBHTTPRSP=IBRESTOBJ.HttpResponse
+43 ; reads json string response from the data stream.
SET IBOUTJSON=IBHTTPRSP.Data.ReadLine()
+44 ; Decode json string DGOUTJSON and return by reference via DGOUT and quit
+45 ;ICR #6682 (Supported)
DO DECODE^XLFJSON("IBOUTJSON","IBOUT")
+46 ;S IBDGOUT=1
+47 ;JWS;10/16/25;pass-failure flag in different location
+48 SET IBRESPONSE=$SELECT($GET(IBOUT("item","pass"))="true":1,1:0)
+49 QUIT IBRESPONSE
+50 ;
ERR ;
+1 QUIT 0
+2 ;
