IBCIUT6 ;DSI/ESG - MAILMAN UTILITIES ;22-JUN-2001
;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
;
CAT(IBIFN,IBCIFRM,IBCITO,IBCIGRP,GRPONLY) ; MailMan message sending
; This procedure is called when the user is assigning a bill to
; another user.
;
; Input variables
; IBIFN - IEN of claim
; IBCIFRM - DUZ of person assigning the claim
; IBCITO - DUZ of person being assigned the claim
; IBCIGRP - IEN of the Mail Group to receive this msg
; (optional - default is "")
; GRPONLY - 1/0 flag indicating if the Mail Group is the only
; entity to receive the mail message.
; (optional - default is 0)
;
NEW ERRDATA,ERRLVL,IBCIASI,IBCIASN,IBCIBII,IBCIBIL,IBCIBIR,IBCICAR
NEW IBCICLNO,IBCICLNP,IBCICNM,IBCICOD,IBCIDAT,IBCIDOB,IBCIDPT,IBCIEVEN
NEW IBCIEVV,IBCIFRM1,IBCIINS,IBCINAM,IBCIPAD,IBCIPRV,IBCIPTI,IBCISER
NEW IBCISEX,IBCISRR,IBCISSN,IBCITO1,L1,L2,L3,LINENO,MNEMONIC,PREVLINE
NEW SEP,TEXT,VALMHDR,XMDUN,XMDUZ,XMZ,XMMG,XMSUB,XMTEXT,XMY
;
S IBCIGRP=$G(IBCIGRP,"")
S GRPONLY=$G(GRPONLY,0)
I IBCIGRP S IBCIGRP=$P($G(^XMB(3.8,IBCIGRP,0)),U,1) ; Mail Group name
S IBCICLNP=$P(^DGCR(399,IBIFN,0),U,1)
S IBCIFRM1=$P(^VA(200,IBCIFRM,0),U,1)
S IBCITO1=$P(^VA(200,IBCITO,0),U,1)
S XMDUZ=IBCIFRM
S XMSUB="ClaimsManager Claim "_IBCICLNP_" Assigned to "_IBCITO1
;
S L1=1
S TEXT(L1)=$J(IBCICLNP_" has been assigned to: ",32)_IBCITO1,L1=L1+1
S TEXT(L1)=$J("by: ",32)_IBCIFRM1,L1=L1+1
S TEXT(L1)=" ",L1=L1+1
;
; If comments exist, then display them here
;
I $P($G(^IBA(351.9,IBIFN,2,0)),U,4) D
. S TEXT(L1)=$$CMTINFO^IBCIUT5(IBIFN),L1=L1+1
. S TEXT(L1)=" ",L1=L1+1
. S L2=0
. F S L2=$O(^IBA(351.9,IBIFN,2,L2)) Q:'L2 D
.. S TEXT(L1)=^IBA(351.9,IBIFN,2,L2,0),L1=L1+1
.. Q
. S TEXT(L1)=" ",L1=L1+1
. S TEXT(L1)=" ",L1=L1+1
. Q
;
; Now get and display the patient and claim data
;
D GDATA^IBCIWK,HDR^IBCIMG
S $P(SEP,"-",80)="" ; 79 dashes
S TEXT(L1)=$E(SEP,1,24)_" Patient and Claim Information "
S TEXT(L1)=TEXT(L1)_$E(SEP,1,24),L1=L1+1
S TEXT(L1)=VALMHDR(1),L1=L1+1
S TEXT(L1)=VALMHDR(2),L1=L1+1
S TEXT(L1)=VALMHDR(3),L1=L1+1
S TEXT(L1)=SEP,L1=L1+1
S TEXT(L1)=" ",L1=L1+1
S TEXT(L1)=$J("ClaimsManager Errors and Line Item Data",59),L1=L1+1
S TEXT(L1)=" ",L1=L1+1
;
; Display a message if there are no errors in the file
I '$P($G(^IBA(351.9,IBIFN,1,0)),U,4) D
. S TEXT(L1)=$J("*** No ClaimsManager Errors to Report ***",60),L1=L1+1
. S TEXT(L1)=" ",L1=L1+1
. Q
;
; Loop through the CM errors and get and display the data
S L2=0
S PREVLINE=-9999999
F S L2=$O(^IBA(351.9,IBIFN,1,L2)) Q:'L2 D
. S ERRDATA=$G(^IBA(351.9,IBIFN,1,L2,0))
. S LINENO=+$P(ERRDATA,U,2)
. I LINENO'=PREVLINE D LINEDATA(IBIFN,LINENO) S PREVLINE=LINENO
. S MNEMONIC=$P(ERRDATA,U,1)
. S ERRLVL="Error Level: "_$P(ERRDATA,"~",2)
. S TEXT(L1)="("_L2_") ClaimsManager Error: "_MNEMONIC
. S TEXT(L1)=(TEXT(L1)_$J(ERRLVL,78-$L(TEXT(L1)))),L1=L1+1
. S L3=0
. F S L3=$O(^IBA(351.9,IBIFN,1,L2,1,L3)) Q:'L3 D
.. S TEXT(L1)=" "_$G(^IBA(351.9,IBIFN,1,L2,1,L3,0)),L1=L1+1
.. Q
. S TEXT(L1)=" ",L1=L1+1
. Q
;
; Now time to do the MailMan stuff
S XMTEXT="TEXT(" ; msg text
I 'GRPONLY S XMY("I:"_IBCITO)="" ; info only msg to recipient
I 'GRPONLY S XMY("I:"_IBCIFRM)="" ; info only msg to sender
I IBCIGRP'="" S XMY("I:G."_IBCIGRP)="" ; info only msg to group
D ^XMD
;
; look at the IB site parameter file to see if we should send
; priority or normal MailMan messages
I '$G(XMZ) G CATX ; no msg created
I $P($G(^IBE(350.9,1,50)),U,7)="N" G CATX ; normal messages
S $P(^XMB(3.9,XMZ,0),U,7)="P" ; priority messages
CATX ;
Q
;
;
LINEDATA(IBIFN,LINE) ; Get and display the line item info
NEW BEGDATE,CHRG,COLHDR,CPT,DXCODE,DXSTRING,ENDDATE,KILLTMP
NEW LNA,LNB,MOD,MODS,MOD2,POS,SEQ,TOS,UNIT,X,X1,X2,X3,X4,Y
;
; Conditionally build the 3,4,5 nodes. Use this flag to indicate
; whether or not to kill these nodes when we're done.
S KILLTMP=0
I '$P($G(^IBA(351.9,IBIFN,3)),U,1) S KILLTMP=1 D UPDT^IBCIADD1
S COLHDR="----------BEG DATE----END DATE----POS---TOS--CPT------"
S COLHDR=COLHDR_"MOD-------CHARGE-----UNIT"
S LNA=$G(^IBA(351.9,IBIFN,5,LINE,0))
S LNB=$G(^IBA(351.9,IBIFN,5,LINE,2))
S BEGDATE=$P(LNA,U,6)
S BEGDATE=$E(BEGDATE,5,6)_"/"_$E(BEGDATE,7,8)_"/"_$E(BEGDATE,1,4)
S ENDDATE=$P(LNA,U,7)
S ENDDATE=$E(ENDDATE,5,6)_"/"_$E(ENDDATE,7,8)_"/"_$E(ENDDATE,1,4)
S POS=$P(LNA,U,8)
S TOS=$P(LNB,U,11)
S CPT=$P(LNA,U,9)
S MODS=$TR($P($G(^IBA(351.9,IBIFN,5,LINE,3)),U,1),",")
S MOD=$E(MODS,1,6),MOD2=$E(MODS,7,999)
S CHRG=$FN($P(LNA,U,11),"",2)
S UNIT=$P(LNB,U,12)
;
; Get the diagnosis information for this line
KILL ^TMP("DISPLAY",$J)
S DXSTRING=""
D DIAG^IBCIUT1(IBIFN)
S SEQ=0
F S SEQ=$O(^TMP("DISPLAY",$J,IBIFN,"ICD",LINE,SEQ)) Q:'SEQ D
. S DXCODE=^TMP("DISPLAY",$J,IBIFN,"ICD",LINE,SEQ)
. I DXSTRING="" S DXSTRING=DXCODE
. E S DXSTRING=DXSTRING_" / "_DXCODE
. Q
KILL ^TMP("DISPLAY",$J)
;
; Now build the text strings for the line item data
S TEXT(L1)=COLHDR,L1=L1+1
S TEXT(L1)=" Line: "
S X=LINE,X1=3,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
S X=BEGDATE,X1=12,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
S X=ENDDATE,X1=12,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
S X=POS,X1=6,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
S X=TOS,X1=5,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
S X=CPT,X1=9,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
S X=MOD,X1=6,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
S X=CHRG,X1=10,X2="R" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
S TEXT(L1)=TEXT(L1)_" "
S X=UNIT,X1=3,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
S L1=L1+1
S TEXT(L1)=" Dx's: "
I $L(DXSTRING)<46,MOD2'="" D
. S X=DXSTRING,X1=47,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
. S X=MOD2,X1=8,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
. Q
E S TEXT(L1)=TEXT(L1)_DXSTRING
S L1=L1+1
;
LINDATX ;
I KILLTMP D DELTI^IBCIUT4
Q
;
TOP(IBIFN) ; This utility returns the type of plan for the current payer
; sequenced insurance company. This is currently used for the
; ClaimsManager UserDefined field #4.
; The data in this field is the actual type of plan defined on VistA.
N IBCITOP,GRPPLAN,IBCISEQ,INSSEQ,TOPIEN
S IBCITOP=""
S IBCISEQ=$$COBN^IBCEF(IBIFN)
S INSSEQ="I"_IBCISEQ
S GRPPLAN=$P($G(^DGCR(399,IBIFN,INSSEQ)),U,18)
I GRPPLAN="" G TOPX
S TOPIEN=$P($G(^IBA(355.3,GRPPLAN,0)),U,9)
I TOPIEN="" G TOPX
S IBCITOP=$P($G(^IBE(355.1,TOPIEN,0)),U,2)
TOPX ;
Q IBCITOP
;
CLRCMQ(MSG) ;
; This procedure will try to clear out the CM result queue by opening
; and using every available port and just reading in any and all
; data CM is wanting to send.
;
; Input: MSG is either 0 or 1 which will determine if status messages
; and/or error messages are displayed on the screen.
; MSG=0 silent mode
; MSG=1 display on screen mode
;
; Output: None (either it will work or it won't)
;
NEW IBCIIP,PORTS,IBCISOCK,JTOT,POP,J,TRASH,SET,IBCIMT
NEW X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S MSG=$G(MSG,1)
S IBCIMT=$$ENV^IBCIUT5
I 'MSG,IBCIMT="T" G CLRX ; don't allow silent mode from TEST acct
;
; If a site isn't using the interface, then display message and exit
I '$$CK0^IBCIUT1(),MSG D G CLRX
. U IO(0)
. W !!!?5,"The ClaimsManager product is not being used."
. W !!?5,"This option is not available.",!!
. S DIR(0)="E" D ^DIR K DIR
. Q
;
I MSG D I 'Y G CLRX
. U IO(0)
. W @IOF
. W !?20,"Clear ClaimsManager Results Queue",!
. W !?2,"This option attempts to clear out the ClaimsManager Results Queue so"
. W !?2,"ClaimsManager can get back in sync with VistA. If this process doesn't"
. W !?2,"correct the problems, then Ingenix should be called (800-765-6818)."
. W !
. I IBCIMT="T" D
.. W !?2,"Please note that you're doing this from the TEST account. This may be"
.. W !?2,"risky if there are Production users using ClaimsManager."
.. W !
.. Q
. S DIR(0)="Y"
. S DIR("A")="OK to proceed"
. S DIR("B")="YES"
. DO ^DIR K DIR
. Q
;
L +^IBCITCP:15 E W:MSG !!,"Couldn't Lock all Ports" G CLRX
S IBCIIP=$P($G(^IBE(350.9,1,50)),U,5)
I IBCIIP="" W:MSG !!,"No IP address" G CLRX
M PORTS=^IBE(350.9,1,50.06,"B")
I '$D(PORTS) W:MSG !!,"No Ports defined" G CLRX
S SET=0
AGAIN ;
S SET=SET+1
W:MSG !!,"Set ",SET
S IBCISOCK="",JTOT=0
F S IBCISOCK=$O(PORTS(IBCISOCK)) Q:IBCISOCK="" D
. W:MSG !?1,"Port# ",IBCISOCK
. D CALL^%ZISTCP(IBCIIP,IBCISOCK,1)
. I POP W:MSG ?16,"FAILURE: Couldn't open port!!" Q
. F J=0:1 R TRASH#1:1 Q:'$T Q:$A(TRASH)=3 Q:TRASH=""
. S JTOT=JTOT+J
. W $C(1,6,3),!
. D CLOSE^%ZISTCP
. I 'MSG Q
. U IO(0)
. W ?15,$J(J,5)," characters read"
. W ?40,"ACK sent to CM"
. W ?58,"Port Closed"
. Q
W:MSG !,"Results of Set ",SET,": "
I JTOT W:MSG "Data was detected. Repeating the process." H 1 G AGAIN
W:MSG "No data found. Process is complete.",!!
CLRX ;
L -^IBCITCP
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCIUT6 9254 printed Oct 16, 2024@18:14:12 Page 2
IBCIUT6 ;DSI/ESG - MAILMAN UTILITIES ;22-JUN-2001
+1 ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
CAT(IBIFN,IBCIFRM,IBCITO,IBCIGRP,GRPONLY) ; MailMan message sending
+1 ; This procedure is called when the user is assigning a bill to
+2 ; another user.
+3 ;
+4 ; Input variables
+5 ; IBIFN - IEN of claim
+6 ; IBCIFRM - DUZ of person assigning the claim
+7 ; IBCITO - DUZ of person being assigned the claim
+8 ; IBCIGRP - IEN of the Mail Group to receive this msg
+9 ; (optional - default is "")
+10 ; GRPONLY - 1/0 flag indicating if the Mail Group is the only
+11 ; entity to receive the mail message.
+12 ; (optional - default is 0)
+13 ;
+14 NEW ERRDATA,ERRLVL,IBCIASI,IBCIASN,IBCIBII,IBCIBIL,IBCIBIR,IBCICAR
+15 NEW IBCICLNO,IBCICLNP,IBCICNM,IBCICOD,IBCIDAT,IBCIDOB,IBCIDPT,IBCIEVEN
+16 NEW IBCIEVV,IBCIFRM1,IBCIINS,IBCINAM,IBCIPAD,IBCIPRV,IBCIPTI,IBCISER
+17 NEW IBCISEX,IBCISRR,IBCISSN,IBCITO1,L1,L2,L3,LINENO,MNEMONIC,PREVLINE
+18 NEW SEP,TEXT,VALMHDR,XMDUN,XMDUZ,XMZ,XMMG,XMSUB,XMTEXT,XMY
+19 ;
+20 SET IBCIGRP=$GET(IBCIGRP,"")
+21 SET GRPONLY=$GET(GRPONLY,0)
+22 ; Mail Group name
IF IBCIGRP
SET IBCIGRP=$PIECE($GET(^XMB(3.8,IBCIGRP,0)),U,1)
+23 SET IBCICLNP=$PIECE(^DGCR(399,IBIFN,0),U,1)
+24 SET IBCIFRM1=$PIECE(^VA(200,IBCIFRM,0),U,1)
+25 SET IBCITO1=$PIECE(^VA(200,IBCITO,0),U,1)
+26 SET XMDUZ=IBCIFRM
+27 SET XMSUB="ClaimsManager Claim "_IBCICLNP_" Assigned to "_IBCITO1
+28 ;
+29 SET L1=1
+30 SET TEXT(L1)=$JUSTIFY(IBCICLNP_" has been assigned to: ",32)_IBCITO1
SET L1=L1+1
+31 SET TEXT(L1)=$JUSTIFY("by: ",32)_IBCIFRM1
SET L1=L1+1
+32 SET TEXT(L1)=" "
SET L1=L1+1
+33 ;
+34 ; If comments exist, then display them here
+35 ;
+36 IF $PIECE($GET(^IBA(351.9,IBIFN,2,0)),U,4)
Begin DoDot:1
+37 SET TEXT(L1)=$$CMTINFO^IBCIUT5(IBIFN)
SET L1=L1+1
+38 SET TEXT(L1)=" "
SET L1=L1+1
+39 SET L2=0
+40 FOR
SET L2=$ORDER(^IBA(351.9,IBIFN,2,L2))
if 'L2
QUIT
Begin DoDot:2
+41 SET TEXT(L1)=^IBA(351.9,IBIFN,2,L2,0)
SET L1=L1+1
+42 QUIT
End DoDot:2
+43 SET TEXT(L1)=" "
SET L1=L1+1
+44 SET TEXT(L1)=" "
SET L1=L1+1
+45 QUIT
End DoDot:1
+46 ;
+47 ; Now get and display the patient and claim data
+48 ;
+49 DO GDATA^IBCIWK
DO HDR^IBCIMG
+50 ; 79 dashes
SET $PIECE(SEP,"-",80)=""
+51 SET TEXT(L1)=$EXTRACT(SEP,1,24)_" Patient and Claim Information "
+52 SET TEXT(L1)=TEXT(L1)_$EXTRACT(SEP,1,24)
SET L1=L1+1
+53 SET TEXT(L1)=VALMHDR(1)
SET L1=L1+1
+54 SET TEXT(L1)=VALMHDR(2)
SET L1=L1+1
+55 SET TEXT(L1)=VALMHDR(3)
SET L1=L1+1
+56 SET TEXT(L1)=SEP
SET L1=L1+1
+57 SET TEXT(L1)=" "
SET L1=L1+1
+58 SET TEXT(L1)=$JUSTIFY("ClaimsManager Errors and Line Item Data",59)
SET L1=L1+1
+59 SET TEXT(L1)=" "
SET L1=L1+1
+60 ;
+61 ; Display a message if there are no errors in the file
+62 IF '$PIECE($GET(^IBA(351.9,IBIFN,1,0)),U,4)
Begin DoDot:1
+63 SET TEXT(L1)=$JUSTIFY("*** No ClaimsManager Errors to Report ***",60)
SET L1=L1+1
+64 SET TEXT(L1)=" "
SET L1=L1+1
+65 QUIT
End DoDot:1
+66 ;
+67 ; Loop through the CM errors and get and display the data
+68 SET L2=0
+69 SET PREVLINE=-9999999
+70 FOR
SET L2=$ORDER(^IBA(351.9,IBIFN,1,L2))
if 'L2
QUIT
Begin DoDot:1
+71 SET ERRDATA=$GET(^IBA(351.9,IBIFN,1,L2,0))
+72 SET LINENO=+$PIECE(ERRDATA,U,2)
+73 IF LINENO'=PREVLINE
DO LINEDATA(IBIFN,LINENO)
SET PREVLINE=LINENO
+74 SET MNEMONIC=$PIECE(ERRDATA,U,1)
+75 SET ERRLVL="Error Level: "_$PIECE(ERRDATA,"~",2)
+76 SET TEXT(L1)="("_L2_") ClaimsManager Error: "_MNEMONIC
+77 SET TEXT(L1)=(TEXT(L1)_$JUSTIFY(ERRLVL,78-$LENGTH(TEXT(L1))))
SET L1=L1+1
+78 SET L3=0
+79 FOR
SET L3=$ORDER(^IBA(351.9,IBIFN,1,L2,1,L3))
if 'L3
QUIT
Begin DoDot:2
+80 SET TEXT(L1)=" "_$GET(^IBA(351.9,IBIFN,1,L2,1,L3,0))
SET L1=L1+1
+81 QUIT
End DoDot:2
+82 SET TEXT(L1)=" "
SET L1=L1+1
+83 QUIT
End DoDot:1
+84 ;
+85 ; Now time to do the MailMan stuff
+86 ; msg text
SET XMTEXT="TEXT("
+87 ; info only msg to recipient
IF 'GRPONLY
SET XMY("I:"_IBCITO)=""
+88 ; info only msg to sender
IF 'GRPONLY
SET XMY("I:"_IBCIFRM)=""
+89 ; info only msg to group
IF IBCIGRP'=""
SET XMY("I:G."_IBCIGRP)=""
+90 DO ^XMD
+91 ;
+92 ; look at the IB site parameter file to see if we should send
+93 ; priority or normal MailMan messages
+94 ; no msg created
IF '$GET(XMZ)
GOTO CATX
+95 ; normal messages
IF $PIECE($GET(^IBE(350.9,1,50)),U,7)="N"
GOTO CATX
+96 ; priority messages
SET $PIECE(^XMB(3.9,XMZ,0),U,7)="P"
CATX ;
+1 QUIT
+2 ;
+3 ;
LINEDATA(IBIFN,LINE) ; Get and display the line item info
+1 NEW BEGDATE,CHRG,COLHDR,CPT,DXCODE,DXSTRING,ENDDATE,KILLTMP
+2 NEW LNA,LNB,MOD,MODS,MOD2,POS,SEQ,TOS,UNIT,X,X1,X2,X3,X4,Y
+3 ;
+4 ; Conditionally build the 3,4,5 nodes. Use this flag to indicate
+5 ; whether or not to kill these nodes when we're done.
+6 SET KILLTMP=0
+7 IF '$PIECE($GET(^IBA(351.9,IBIFN,3)),U,1)
SET KILLTMP=1
DO UPDT^IBCIADD1
+8 SET COLHDR="----------BEG DATE----END DATE----POS---TOS--CPT------"
+9 SET COLHDR=COLHDR_"MOD-------CHARGE-----UNIT"
+10 SET LNA=$GET(^IBA(351.9,IBIFN,5,LINE,0))
+11 SET LNB=$GET(^IBA(351.9,IBIFN,5,LINE,2))
+12 SET BEGDATE=$PIECE(LNA,U,6)
+13 SET BEGDATE=$EXTRACT(BEGDATE,5,6)_"/"_$EXTRACT(BEGDATE,7,8)_"/"_$EXTRACT(BEGDATE,1,4)
+14 SET ENDDATE=$PIECE(LNA,U,7)
+15 SET ENDDATE=$EXTRACT(ENDDATE,5,6)_"/"_$EXTRACT(ENDDATE,7,8)_"/"_$EXTRACT(ENDDATE,1,4)
+16 SET POS=$PIECE(LNA,U,8)
+17 SET TOS=$PIECE(LNB,U,11)
+18 SET CPT=$PIECE(LNA,U,9)
+19 SET MODS=$TRANSLATE($PIECE($GET(^IBA(351.9,IBIFN,5,LINE,3)),U,1),",")
+20 SET MOD=$EXTRACT(MODS,1,6)
SET MOD2=$EXTRACT(MODS,7,999)
+21 SET CHRG=$FNUMBER($PIECE(LNA,U,11),"",2)
+22 SET UNIT=$PIECE(LNB,U,12)
+23 ;
+24 ; Get the diagnosis information for this line
+25 KILL ^TMP("DISPLAY",$JOB)
+26 SET DXSTRING=""
+27 DO DIAG^IBCIUT1(IBIFN)
+28 SET SEQ=0
+29 FOR
SET SEQ=$ORDER(^TMP("DISPLAY",$JOB,IBIFN,"ICD",LINE,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+30 SET DXCODE=^TMP("DISPLAY",$JOB,IBIFN,"ICD",LINE,SEQ)
+31 IF DXSTRING=""
SET DXSTRING=DXCODE
+32 IF '$TEST
SET DXSTRING=DXSTRING_" / "_DXCODE
+33 QUIT
End DoDot:1
+34 KILL ^TMP("DISPLAY",$JOB)
+35 ;
+36 ; Now build the text strings for the line item data
+37 SET TEXT(L1)=COLHDR
SET L1=L1+1
+38 SET TEXT(L1)=" Line: "
+39 SET X=LINE
SET X1=3
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+40 SET X=BEGDATE
SET X1=12
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+41 SET X=ENDDATE
SET X1=12
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+42 SET X=POS
SET X1=6
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+43 SET X=TOS
SET X1=5
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+44 SET X=CPT
SET X1=9
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+45 SET X=MOD
SET X1=6
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+46 SET X=CHRG
SET X1=10
SET X2="R"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+47 SET TEXT(L1)=TEXT(L1)_" "
+48 SET X=UNIT
SET X1=3
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+49 SET L1=L1+1
+50 SET TEXT(L1)=" Dx's: "
+51 IF $LENGTH(DXSTRING)<46
IF MOD2'=""
Begin DoDot:1
+52 SET X=DXSTRING
SET X1=47
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+53 SET X=MOD2
SET X1=8
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+54 QUIT
End DoDot:1
+55 IF '$TEST
SET TEXT(L1)=TEXT(L1)_DXSTRING
+56 SET L1=L1+1
+57 ;
LINDATX ;
+1 IF KILLTMP
DO DELTI^IBCIUT4
+2 QUIT
+3 ;
TOP(IBIFN) ; This utility returns the type of plan for the current payer
+1 ; sequenced insurance company. This is currently used for the
+2 ; ClaimsManager UserDefined field #4.
+3 ; The data in this field is the actual type of plan defined on VistA.
+4 NEW IBCITOP,GRPPLAN,IBCISEQ,INSSEQ,TOPIEN
+5 SET IBCITOP=""
+6 SET IBCISEQ=$$COBN^IBCEF(IBIFN)
+7 SET INSSEQ="I"_IBCISEQ
+8 SET GRPPLAN=$PIECE($GET(^DGCR(399,IBIFN,INSSEQ)),U,18)
+9 IF GRPPLAN=""
GOTO TOPX
+10 SET TOPIEN=$PIECE($GET(^IBA(355.3,GRPPLAN,0)),U,9)
+11 IF TOPIEN=""
GOTO TOPX
+12 SET IBCITOP=$PIECE($GET(^IBE(355.1,TOPIEN,0)),U,2)
TOPX ;
+1 QUIT IBCITOP
+2 ;
CLRCMQ(MSG) ;
+1 ; This procedure will try to clear out the CM result queue by opening
+2 ; and using every available port and just reading in any and all
+3 ; data CM is wanting to send.
+4 ;
+5 ; Input: MSG is either 0 or 1 which will determine if status messages
+6 ; and/or error messages are displayed on the screen.
+7 ; MSG=0 silent mode
+8 ; MSG=1 display on screen mode
+9 ;
+10 ; Output: None (either it will work or it won't)
+11 ;
+12 NEW IBCIIP,PORTS,IBCISOCK,JTOT,POP,J,TRASH,SET,IBCIMT
+13 NEW X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+14 SET MSG=$GET(MSG,1)
+15 SET IBCIMT=$$ENV^IBCIUT5
+16 ; don't allow silent mode from TEST acct
IF 'MSG
IF IBCIMT="T"
GOTO CLRX
+17 ;
+18 ; If a site isn't using the interface, then display message and exit
+19 IF '$$CK0^IBCIUT1()
IF MSG
Begin DoDot:1
+20 USE IO(0)
+21 WRITE !!!?5,"The ClaimsManager product is not being used."
+22 WRITE !!?5,"This option is not available.",!!
+23 SET DIR(0)="E"
DO ^DIR
KILL DIR
+24 QUIT
End DoDot:1
GOTO CLRX
+25 ;
+26 IF MSG
Begin DoDot:1
+27 USE IO(0)
+28 WRITE @IOF
+29 WRITE !?20,"Clear ClaimsManager Results Queue",!
+30 WRITE !?2,"This option attempts to clear out the ClaimsManager Results Queue so"
+31 WRITE !?2,"ClaimsManager can get back in sync with VistA. If this process doesn't"
+32 WRITE !?2,"correct the problems, then Ingenix should be called (800-765-6818)."
+33 WRITE !
+34 IF IBCIMT="T"
Begin DoDot:2
+35 WRITE !?2,"Please note that you're doing this from the TEST account. This may be"
+36 WRITE !?2,"risky if there are Production users using ClaimsManager."
+37 WRITE !
+38 QUIT
End DoDot:2
+39 SET DIR(0)="Y"
+40 SET DIR("A")="OK to proceed"
+41 SET DIR("B")="YES"
+42 DO ^DIR
KILL DIR
+43 QUIT
End DoDot:1
IF 'Y
GOTO CLRX
+44 ;
+45 LOCK +^IBCITCP:15
IF '$TEST
if MSG
WRITE !!,"Couldn't Lock all Ports"
GOTO CLRX
+46 SET IBCIIP=$PIECE($GET(^IBE(350.9,1,50)),U,5)
+47 IF IBCIIP=""
if MSG
WRITE !!,"No IP address"
GOTO CLRX
+48 MERGE PORTS=^IBE(350.9,1,50.06,"B")
+49 IF '$DATA(PORTS)
if MSG
WRITE !!,"No Ports defined"
GOTO CLRX
+50 SET SET=0
AGAIN ;
+1 SET SET=SET+1
+2 if MSG
WRITE !!,"Set ",SET
+3 SET IBCISOCK=""
SET JTOT=0
+4 FOR
SET IBCISOCK=$ORDER(PORTS(IBCISOCK))
if IBCISOCK=""
QUIT
Begin DoDot:1
+5 if MSG
WRITE !?1,"Port# ",IBCISOCK
+6 DO CALL^%ZISTCP(IBCIIP,IBCISOCK,1)
+7 IF POP
if MSG
WRITE ?16,"FAILURE: Couldn't open port!!"
QUIT
+8 FOR J=0:1
READ TRASH#1:1
if '$TEST
QUIT
if $ASCII(TRASH)=3
QUIT
if TRASH=""
QUIT
+9 SET JTOT=JTOT+J
+10 WRITE $CHAR(1,6,3),!
+11 DO CLOSE^%ZISTCP
+12 IF 'MSG
QUIT
+13 USE IO(0)
+14 WRITE ?15,$JUSTIFY(J,5)," characters read"
+15 WRITE ?40,"ACK sent to CM"
+16 WRITE ?58,"Port Closed"
+17 QUIT
End DoDot:1
+18 if MSG
WRITE !,"Results of Set ",SET,": "
+19 IF JTOT
if MSG
WRITE "Data was detected. Repeating the process."
HANG 1
GOTO AGAIN
+20 if MSG
WRITE "No data found. Process is complete.",!!
CLRX ;
+1 LOCK -^IBCITCP
+2 QUIT
+3 ;
