Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCIUT2

IBCIUT2.m

Go to the documentation of this file. 
  1. IBCIUT2 ;DSI/SLM - CLAIMSMANAGER MESSAGE UTILITIES ;21-DEC-2000
  1.  ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  Q
  1. MSGHDR ;build message id segment
  1.  ;
  1.  K IBCIU
  1.  S IBCIU(1)=$C(28),IBCIU(2)=$C(29),IBCIU(3)=$C(30),IBCIU(4)=$C(94),IBCIU(5)=$C(39),IBCIU(6)=$C(37)
  1.  S IBCIAA="" F I=1:1:6 S IBCIAA=IBCIAA_IBCIU(I)
  1.  K IBCIHDR S IBCIHDR=IBCIAA_"CLAIM"_IBCIU(1)
  1.  ;
  1. RSEG ;build route segment
  1.  N X,X1,X2,X3,X4,Y
  1.  S IBCIHDR=IBCIHDR_IBCIU(3)_IBCIU(3)
  1.  S X=IBCIMT,X1=3,IBCIMT=$$FILL
  1.  K X D NOW^IBCIUT1 S X=Y,X1=16,IBCIMDT=$$FILL
  1.  S X="",X1=20,IBCIMCID=$$FILL,IBCIMP="H"
  1.  S IBCIUID="DVAUSER",X=IBCIUID,X1=10,IBCIUID=$$FILL
  1.  S IBCISAP="VISTA",X=IBCISAP,X1=20,IBCISAP=$$FILL
  1.  S IBCIRAP="CLAIMS MANAGER",X=IBCIRAP,X1=20,IBCIRAP=$$FILL
  1.  S IBCISI="",X=IBCISI,X1=30,X3=".",IBCISI=$$FILL K X3
  1.  ;
  1.  S IBCIHDR=IBCIHDR_IBCIMT_IBCIMDT_IBCIMCID_IBCIMP_IBCIUID
  1.  S IBCIHDR=IBCIHDR_IBCIU(3)_IBCISAP_IBCIU(3)_IBCIRAP
  1.  S IBCIHDR=IBCIHDR_IBCIU(3)_IBCISI_IBCIU(1)
  1.  ;
  1.  Q
  1. FILL() ;pad x with characters
  1.  ;
  1.  ;Input variables
  1.  ;  X  = input value in non-fixed format
  1.  ;  X1 = desired length of the output (default is 80 if undefined)
  1.  ;  X2 = justify 'R' or 'L' (if undefined or not [ R or L, default is 'L')
  1.  ;  X3 = character you want x padded with (default is " ")
  1.  ;  X4 = truncate flag - if [ 'T' and x>x1 it will be truncated (default is 'T')
  1.  ;
  1.  ;Output variable
  1.  ;  Y
  1.  ;
  1.  S Y=""
  1.  Q:'$D(X) Y
  1.  ;
  1.  ;initialize variables for fill
  1.  ;
  1.  I '$D(X1) S X1=80
  1.  I X1<1 S X1=80
  1.  I '$D(X2) S X2="L"
  1.  I "RL"'[X2 S X2="L"
  1.  I X2["R"&(X2["L") S X2="L"
  1.  I '$D(X3) S X3=" "
  1.  I X3']"" S X3=" "
  1.  I '$D(X4) S X4="T"
  1.  ;
  1.  I X4["T"&($L(X)>X1) S Y=$E(X,1,X1) Q Y
  1.  ;
  1.  S Y="",$P(Y,X3,X1+1)="",Y=$E(Y,1,X1-$L(X))
  1.  I X2["R" S Y=Y_X
  1.  I X2["L" S Y=X_Y
  1.  Q Y
  1.  ;
  1.  ;asnd(ibifn) comments
  1.  ;Input Variable
  1.  ;  ibifn
  1.  ;Output Variable
  1.  ;  y = 1 if successful, = 0 if not.
  1. ASND(IBIFN) ;auto send to ClaimsManager
  1.  N IBCIY S IBCIY=0,IBCIERR="" K PROBLEM
  1.  Q:'$D(IBIFN) IBCIY
  1.  ;change status in 351.9
  1.  I IBCISNT'=3 D
  1.  .S IBCIST=$S(IBCISNT=6:8,IBCISNT=5:5,IBCISNT=4:9,1:2)
  1.  .D ST^IBCIUT1(IBCIST)
  1.  ;
  1.  D UPDT^IBCIADD1   ;update 351.9 for all cases
  1.  ;
  1.  I IBCISNT<3 D  ;a normal claim that has not been authorized
  1.  .D EN^IBCIMSG,SEND
  1.  .I '$G(PROBLEM) S IBCIY=1 D
  1.  ..I $P(^IBA(351.9,IBIFN,0),U,15)'=1 D  ;set received by cm to yes
  1.  ...S DIE="^IBA(351.9,",DA=IBIFN,DR=".15///1" D ^DIE K DIE,DA,DR
  1.  ..I $P($G(^IBA(351.9,IBIFN,2,0)),U,4) D DCOM^IBCIUT4(IBIFN)
  1.  ..I $$CKNER^IBCIUT1() D  Q  ;if no errors then...
  1.  ...S (IBCISTAT,IBCIST)=3 D ST^IBCIUT1(IBCIST)    ;update status=3
  1.  ...D DELTI^IBCIUT4   ;delete temp info when passed w/o errors
  1.  ...D DELER^IBCIUT4   ;delete error information too
  1.  ...D DASN^IBCIUT5(IBIFN)   ;remove the assigned to person
  1.  ...Q
  1.  ..D Z1AR^IBCIUT4           ;errors found then..
  1.  ..S (IBCISTAT,IBCIST)=4 D ST^IBCIUT1(IBCIST)
  1.  ..I IBCISNT=2 D COMMENT^IBCIUT7(IBIFN,4)  ; log a comment in auto-send
  1.  ..Q                                       ; mode when errors are found
  1.  .I $G(PROBLEM) S IBCIERR=$$P1^IBCIUT4(PROBLEM) D  ;comm errors
  1.  ..S (IBCISTAT,IBCIST)=6 D ST^IBCIUT1(IBCIST) Q
  1.  ;
  1.  I IBCISNT=3 D  ;test send
  1.  .D EN^IBCIMSG,SEND
  1.  .I '$G(PROBLEM) S IBCIY=1 D
  1.  ..I $$CKNER^IBCIUT1() S IBCISTAT=3 Q  ;no errors...
  1.  ..D Z1AR^IBCIUT4 S IBCISTAT=4 Q  ;error(s) found
  1.  .I $G(PROBLEM) S IBCIERR=$$P1^IBCIUT4(PROBLEM),IBCISTAT=6 Q  ;comm errors
  1.  .D TST ;put in tmp global
  1.  ;
  1.  I IBCISNT=4!(IBCISNT=5) D  ;canceled, overridden
  1.  .D EN^IBCIMSG,SEND
  1.  .I '$G(PROBLEM) S IBCIY=1 D
  1.  ..S IBCISTAT=$$STAT^IBCIUT1(IBIFN)
  1.  ..D DELTI^IBCIUT4                ;delete temp information
  1.  ..D DASN^IBCIUT5(IBIFN)          ;remove the assigned to person
  1.  ..I IBCISNT=4 D DELER^IBCIUT4    ;delete errors
  1.  .I $G(PROBLEM) D  ;comm error
  1.  ..S (IBCISTAT,IBCIST)=$S(IBCISNT=5:11,IBCISNT=4:10,1:6)
  1.  ..D ST^IBCIUT1(IBCIST)
  1.  ..S IBCIERR=$$P1^IBCIUT4(PROBLEM)
  1.  ;
  1.  I IBCISNT=6 D  ;historical
  1.  .S IBCISNT=1 D EN^IBCIMSG,SEND ;send first as a normal claim
  1.  .I '$G(PROBLEM) D  Q
  1.  ..I '$$CKNER^IBCIUT1() D Z1AR^IBCIUT4 ;store them
  1.  ..H 2      ; pause between sendings to CM
  1.  ..S IBCISNT=6 D EN^IBCIMSG,SEND ;reset ibcisnt to 6 and send again
  1.  ..I '$G(PROBLEM) S IBCIY=1 D  Q
  1.  ...S (IBCISTAT,IBCIST)=8 D ST^IBCIUT1(IBCIST)
  1.  ...D DELTI^IBCIUT4    ; remove the temp nodes
  1.  ...Q
  1.  ..I $G(PROBLEM) D  Q  ;comm error on second send
  1.  ...S (IBCISTAT,IBCIST)=6 D ST^IBCIUT1(IBCIST)
  1.  ...S IBCIERR=$$P1^IBCIUT4(PROBLEM)
  1.  .I $G(PROBLEM) D  Q  ;comm error on first send
  1.  ..S (IBCISTAT,IBCIST)=6 D ST^IBCIUT1(IBCIST)
  1.  ..S IBCIERR=$$P1^IBCIUT4(PROBLEM)
  1.  ..S IBCISNT=6
  1.  ;
  1.  ; Add new send type - esg - 1/3/2002
  1.  I IBCISNT=7 D         ; delete lines from a UB bill on CM
  1.  . D EN^IBCIMSG,SEND
  1.  . S IBCISTAT=""
  1.  . I '$G(PROBLEM) S IBCIY=1
  1.  . I $G(PROBLEM) S IBCIERR=$$P1^IBCIUT4(PROBLEM)
  1.  . Q
  1.  ;
  1.  I '$G(IBCIERR) S IBCIERR=""
  1.  Q IBCIY
  1.  ;
  1. WRT ;write the message to io
  1.  ;
  1.  N I,J,ICD0,LITMS,MOD,TOTMOD
  1.  S IBCICC=0,IBCIOS=^%ZOSF("OS") D MSGHDR W IBCIHDR
  1.  S FLUSH=$S(IBCIOS["MSM":"#",IBCIOS["OpenM":"!",1:"!")
  1.  S IBCICC=IBCICC+$L(IBCIHDR) D ^IBCIUDF
  1.  ;
  1.  ; Data elements in the Header Segment
  1.  F I=1:1:19 D
  1.  .S IBCICC=IBCICC+$L(^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,I))
  1.  .I IBCICC>200 W @FLUSH S IBCICC=0
  1.  .W ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,I)
  1.  ;
  1.  ; Determine the # of line items.  Write the data elements in the
  1.  ; Line Segments (ExtLineID field through Units field)
  1.  ;
  1.  S LITMS=$P($G(^IBA(351.9,IBIFN,5,0)),U,4)
  1.  I LITMS W IBCIU(1) F J=1:1:LITMS D
  1.  .F I=20:1:52 D
  1.  ..S IBCICC=IBCICC+$L(^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,J,I))
  1.  ..I IBCICC>200 W @FLUSH S IBCICC=0
  1.  ..W ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,J,I)
  1.  .;
  1.  .W IBCIU(3)    ; field delimiter between Units and ICDCode
  1.  .;
  1.  .; icd codes - was node 53, now just an array
  1.  .; Repeating Field
  1.  .F I=1:1:$P($G(^TMP("IBCIMSG",$J,IBIFN,"ICD",J,0)),U,2) D
  1.  ..S IBCICC=IBCICC+$L(^TMP("IBCIMSG",$J,IBIFN,"ICD",J,I))
  1.  ..I IBCICC>200 W @FLUSH S IBCICC=0
  1.  ..W ^TMP("IBCIMSG",$J,IBIFN,"ICD",J,I)
  1.  ..I I'=$P(^TMP("IBCIMSG",$J,IBIFN,"ICD",J,0),U,2) W IBCIU(4)
  1.  .;
  1.  .W IBCIU(3)    ; field delimiter between ICDCode and Modifier
  1.  .;
  1.  .; cpt code node 54 multiple
  1.  .; CPT Modifier(s). Repeating Field
  1.  .S TOTMOD=$P(^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,J,54,0),U,1)
  1.  .F I=1:1:TOTMOD D
  1.  ..S MOD=^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,J,54,I)
  1.  ..S IBCICC=IBCICC+$L(MOD)
  1.  ..I IBCICC>200 W @FLUSH S IBCICC=0
  1.  ..W MOD
  1.  ..I I'=TOTMOD W IBCIU(4)
  1.  .;
  1.  .W IBCIU(3)    ; field delimiter between Modifier and UDF#1
  1.  .;
  1.  .; insert the user defined fields, 2 extra field delimiters, and
  1.  .; a line segment repetition delimiter if we're not done
  1.  .;
  1.  .F I=1:1:25 W IBCIUDF(I),IBCIU(3)
  1.  .W IBCIU(3),IBCIU(3)
  1.  .I J'=LITMS W IBCIU(2)
  1.  ;
  1.  D CLEAN1
  1.  Q
  1.  ;
  1. SEND ;open the tcp/ip port and send msg then read response
  1.  I '$$OPENUSE^IBCIUT5 S PROBLEM=99 Q
  1.  W $C(1) D WRT W $C(3),@FLUSH
  1.  D READ^IBCIUT3(.IBCIZ,.PROBLEM,IBCISOCK)
  1.  KILL FLUSH,IBCICC,IBCIOS,IBCISOCK
  1.  Q
  1.  ;
  1. TST ;if test send, put errors in tmp global
  1.  N IBCIDA,IBCIDA1,IBCICNT K ^TMP("IBCITST",$J) S IBCICNT=1
  1.  S IBCIDA=0 F  S IBCIDA=$O(IBCIZ1(IBCIDA)) Q:'IBCIDA  D
  1.  .S IBCIDA1=0 S ^TMP("IBCITST",$J,IBCICNT,IBCIDA1)=IBCIZ1(IBCIDA,IBCIDA1)
  1.  .F  S IBCIDA1=$O(IBCIZ1(IBCIDA,IBCIDA1)) Q:'IBCIDA1  D
  1.  ..S ^TMP("IBCITST",$J,IBCICNT,1,IBCIDA1,0)=IBCIZ1(IBCIDA,IBCIDA1)
  1.  .S IBCICNT=IBCICNT+1
  1.  Q
  1.  ;
  1. CLEAN1 ; clean up the variables
  1.  K ^TMP("IBCIMSG",$J),IBCIU,IBCICLNP,IBCIUDF
  1. CLEAN ;
  1.  K ^TMP("IBXSAVE",$J)
  1.  K X,Y,N1,D0,DA,DIC,DIE,DR,I,II,J,%,CT
  1.  K IBCIAA,IBCIAPC,IBCIAPID,IBCIBDPS,IBCIBPDE
  1.  K IBCIBPDI,IBCIBPFI,IBCIBPID,IBCIBPLA,IBCIBPMI,IBCIBPSP
  1.  K IBCIBPTI,IBCIBPUP,IBCICL,IBCICPT,IBCIDE,IBCIDFN,IBCIBDOS
  1.  K IBCIDOB,IBCIEB,IBCIEBID,IBCIEDOS,IBCIET,IBCIHDR
  1.  K IBCILSEG,IBCILSTA,IBCIMCID,IBCIMDT,IBCIMP
  1.  K IBCIOGID,IBCIOID,IBCIPAC,IBCIPID,IBCIPOS,IBCIPPID
  1.  K IBCIPTFI,IBCIPTLA,IBCIPTMI,IBCIRAP,IBCIRPDE,IBCIRPDI,IBCIRPFI
  1.  K IBCIRPID,IBCIRPLA,IBCIRPMI,IBCIRPSP,IBCIRPTI,IBCIRPUP,IBCISAMT
  1.  K IBCISAP,IBCISEX,IBCISI,IBCISPAI,IBCISPC,IBCISPDE,IBCISPDI
  1.  K IBCISPFI,IBCISPID,IBCISPLA,IBCISPMI,IBCISPSP,IBCISPTI,IBCISPUP
  1.  K IBCIST,IBCITC,IBCITOS,IBCIUID,IBCIUNIT,IBCIXLID,IBX,IBY
  1.  K IENS,NODE3,NODE4,NODE50,NODE51,NODE52,RCD1,CPD1
  1.  K IBCIZ,IBCIZ1,IBXARRAY,IBXARRY,IBXDAT1,IBXDATA,IBXERR
  1.  K IBCITSI,X1,X2,X3,X4,IBCILSI,CTR
  1.  Q
  1.  ;