IBCIMSG1 ;DSI/SLM - BUILD MESSAGE FOR CLAIMSMANAGER CONT'D ;16-JAN-2001
;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
INIT1 ;continued from ibcimsg, building the line segments message
N I
S IBCILSEG=0 F S IBCILSEG=$O(^IBA(351.9,IBIFN,5,IBCILSEG)) Q:'IBCILSEG D
.S X=$G(^IBA(351.9,IBIFN,5,IBCILSEG,0)) D TCK^IBCIUT4() S NODE50=X
.S X=$G(^IBA(351.9,IBIFN,5,IBCILSEG,1)) D TCK^IBCIUT4() S NODE51=X
.S X=$G(^IBA(351.9,IBIFN,5,IBCILSEG,2)) D TCK^IBCIUT4() S NODE52=X K X
.S IBCIXLID(IBCILSEG)=$P(NODE50,U,2)
.S X=IBCIXLID(IBCILSEG),X1=25,IBCIXLID(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,20)=IBCIXLID(IBCILSEG)
.S IBCIOGID(IBCILSEG)=$P(NODE50,U,3)
.S X=IBCIOGID(IBCILSEG),X1=20,IBCIOGID(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,21)=IBCIOGID(IBCILSEG)
.S IBCIOID(IBCILSEG)=$P(NODE50,U,4)
.S X=IBCIOID(IBCILSEG),X1=20,IBCIOID(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,22)=IBCIOID(IBCILSEG)
.S IBCILSTA(IBCILSEG)=$$LSTA^IBCIUT1(IBCISNT)
.S X=IBCILSTA(IBCILSEG),X1=3,X4="T",IBCILSTA(IBCILSEG)=$$FILL^IBCIUT2 K X4
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,23)=IBCILSTA(IBCILSEG)
.S IBCIBDOS(IBCILSEG)=$P(NODE50,U,6)
.S X=IBCIBDOS(IBCILSEG),X1=16,IBCIBDOS(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,24)=IBCIBDOS(IBCILSEG)
.S IBCIEDOS(IBCILSEG)=$P(NODE50,U,7)
.S X=IBCIEDOS(IBCILSEG),X1=16,IBCIEDOS(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,25)=IBCIEDOS(IBCILSEG)
.S IBCIPOS(IBCILSEG)=$P(NODE50,U,8)
.S X=IBCIPOS(IBCILSEG),X1=3,X4="T",IBCIPOS(IBCILSEG)=$$FILL^IBCIUT2 K X4
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,26)=IBCIPOS(IBCILSEG)
.S IBCISPC(IBCILSEG)=$P(NODE50,U,9)
.S X=IBCISPC(IBCILSEG),X1=25,IBCISPC(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,27)=IBCISPC(IBCILSEG)
.S IBCIAPC(IBCILSEG)=$P(NODE50,U,10)
.S X=IBCIAPC(IBCILSEG),X1=25,IBCIAPC(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,28)=IBCIAPC(IBCILSEG)
.S IBCISAMT(IBCILSEG)=$P(NODE50,U,11)
.;
.; esg - 7/5/01 - correct the format of the $ amount
.S IBCISAMT(IBCILSEG)=+$TR($FN(IBCISAMT(IBCILSEG),"",2),".")
.S X=IBCISAMT(IBCILSEG),X1=15,IBCISAMT(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,29)=IBCISAMT(IBCILSEG)
.S IBCIPAC(IBCILSEG)=$P(NODE50,U,12)
.S X=IBCIPAC(IBCILSEG),X1=15,IBCIPAC(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,30)=IBCIPAC(IBCILSEG)
.S IBCISPID(IBCILSEG)=$P(NODE50,U,13)
.S X=IBCISPID(IBCILSEG),X1=20,IBCISPID(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,31)=IBCISPID(IBCILSEG)
.S IBCISPLA(IBCILSEG)=$P(NODE51,U,1)
.S X=IBCISPLA(IBCILSEG),X1=40,IBCISPLA(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,32)=IBCISPLA(IBCILSEG)
.S IBCISPMI(IBCILSEG)=$P(NODE51,U,2)
.S X=IBCISPMI(IBCILSEG),X1=20,IBCISPMI(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,33)=IBCISPMI(IBCILSEG)
.S IBCISPFI(IBCILSEG)=$P(NODE51,U,3)
.S X=IBCISPFI(IBCILSEG),X1=20,IBCISPFI(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,34)=IBCISPFI(IBCILSEG)
.S IBCISPTI(IBCILSEG)=$P(NODE51,U,4)
.S X=IBCISPTI(IBCILSEG),X1=5,X4="T",IBCISPTI(IBCILSEG)=$$FILL^IBCIUT2 K X4
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,35)=IBCISPTI(IBCILSEG)
.S IBCISPDE(IBCILSEG)=$P(NODE51,U,5)
.S X=IBCISPDE(IBCILSEG),X1=20,IBCISPDE(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,36)=IBCISPDE(IBCILSEG)
.S IBCISPSP(IBCILSEG)=$P(NODE51,U,6)
.S X=IBCISPSP(IBCILSEG),X1=10,IBCISPSP(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,37)=IBCISPSP(IBCILSEG)
.S IBCISPDI(IBCILSEG)=$P(NODE51,U,7)
.S X=IBCISPDI(IBCILSEG),X1=10,IBCISPDI(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,38)=IBCISPDI(IBCILSEG)
.S IBCISPUP(IBCILSEG)=$P(NODE51,U,8)
.S X=IBCISPUP(IBCILSEG),X1=10,IBCISPUP(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,39)=IBCISPUP(IBCILSEG)
.S IBCIBPID(IBCILSEG)=$P(NODE51,U,9)
.S X=IBCIBPID(IBCILSEG),X1=20,IBCIBPID(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,40)=IBCIBPID(IBCILSEG)
.S IBCIBPLA(IBCILSEG)=$P(NODE52,U,1)
.S X=IBCIBPLA(IBCILSEG),X1=40,IBCIBPLA(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,41)=IBCIBPLA(IBCILSEG)
.S IBCIBPMI(IBCILSEG)=$P(NODE52,U,2)
.S X=IBCIBPMI(IBCILSEG),X1=20,IBCIBPMI(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,42)=IBCIBPMI(IBCILSEG)
.S IBCIBPFI(IBCILSEG)=$P(NODE52,U,3)
.S X=IBCIBPFI(IBCILSEG),X1=20,IBCIBPFI(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,43)=IBCIBPFI(IBCILSEG)
.S IBCIBPTI(IBCILSEG)=$P(NODE52,U,4)
.S X=IBCIBPTI(IBCILSEG),X1=5,X4="T",IBCIBPTI(IBCILSEG)=$$FILL^IBCIUT2 K X4
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,44)=IBCIBPTI(IBCILSEG)
.S IBCIBPDE(IBCILSEG)=$P(NODE52,U,5)
.S X=IBCIBPDE(IBCILSEG),X1=20,X4="T",IBCIBPDE(IBCILSEG)=$$FILL^IBCIUT2 K X4
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,45)=IBCIBPDE(IBCILSEG)
.S IBCIBPSP(IBCILSEG)=$P(NODE52,U,6)
.S X=IBCIBPSP(IBCILSEG),X1=10,IBCIBPSP(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,46)=IBCIBPSP(IBCILSEG)
.S IBCIBPDI(IBCILSEG)=$P(NODE52,U,7)
.S X=IBCIBPDI(IBCILSEG),X1=10,IBCIBPDI(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,47)=IBCIBPDI(IBCILSEG)
.S IBCIBPUP(IBCILSEG)=$P(NODE52,U,8)
.S X=IBCIBPUP(IBCILSEG),X1=10,IBCIBPUP(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,48)=IBCIBPUP(IBCILSEG)
.S IBCIPPID(IBCILSEG)=$P(NODE52,U,9)
.S X=IBCIPPID(IBCILSEG),X1=20,IBCIPPID(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,49)=IBCIPPID(IBCILSEG)
.S IBCISPAI(IBCILSEG)=$P(NODE52,U,10)
.S X=IBCISPAI(IBCILSEG),X1=20,IBCISPAI(IBCILSEG)=$$FILL^IBCIUT2
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,50)=IBCISPAI(IBCILSEG)
.S IBCITOS(IBCILSEG)=$P(NODE52,U,11)
.S X=IBCITOS(IBCILSEG),X1=3,X4="T",IBCITOS(IBCILSEG)=$$FILL^IBCIUT2 K X4
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,51)=IBCITOS(IBCILSEG)
.S IBCIUNIT(IBCILSEG)=$P(NODE52,U,12)
.S X=IBCIUNIT(IBCILSEG),X1=5,X4="T",IBCIUNIT(IBCILSEG)=$$FILL^IBCIUT2 K X4
.S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,52)=IBCIUNIT(IBCILSEG)
CPT .;get cpt modifiers
.S IBCICPT(IBCILSEG,0)=$P($G(^IBA(351.9,IBIFN,5,IBCILSEG,3)),U)
.I IBCICPT(IBCILSEG,0)["," F I=1:1 Q:$P(IBCICPT(IBCILSEG,0),",",I)']"" D
..S IBCICPT(IBCILSEG,I)=$P(IBCICPT(IBCILSEG,0),",",I)
.E S IBCICPT(IBCILSEG,1)=IBCICPT(IBCILSEG,0)
.S (CT,I)=0 F S I=$O(IBCICPT(IBCILSEG,I)) Q:'I D
..S X=IBCICPT(IBCILSEG,I) D CCK^IBCIUT4(),TCK^IBCIUT4()
..S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,54,I)=IBCICPT(IBCILSEG,I)
..S CT=CT+1,^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,54,0)=CT_U
Q Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCIMSG1 7049 printed Oct 16, 2024@18:14 Page 2
IBCIMSG1 ;DSI/SLM - BUILD MESSAGE FOR CLAIMSMANAGER CONT'D ;16-JAN-2001
+1 ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
INIT1 ;continued from ibcimsg, building the line segments message
+1 NEW I
+2 SET IBCILSEG=0
FOR
SET IBCILSEG=$ORDER(^IBA(351.9,IBIFN,5,IBCILSEG))
if 'IBCILSEG
QUIT
Begin DoDot:1
+3 SET X=$GET(^IBA(351.9,IBIFN,5,IBCILSEG,0))
DO TCK^IBCIUT4()
SET NODE50=X
+4 SET X=$GET(^IBA(351.9,IBIFN,5,IBCILSEG,1))
DO TCK^IBCIUT4()
SET NODE51=X
+5 SET X=$GET(^IBA(351.9,IBIFN,5,IBCILSEG,2))
DO TCK^IBCIUT4()
SET NODE52=X
KILL X
+6 SET IBCIXLID(IBCILSEG)=$PIECE(NODE50,U,2)
+7 SET X=IBCIXLID(IBCILSEG)
SET X1=25
SET IBCIXLID(IBCILSEG)=$$FILL^IBCIUT2
+8 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,20)=IBCIXLID(IBCILSEG)
+9 SET IBCIOGID(IBCILSEG)=$PIECE(NODE50,U,3)
+10 SET X=IBCIOGID(IBCILSEG)
SET X1=20
SET IBCIOGID(IBCILSEG)=$$FILL^IBCIUT2
+11 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,21)=IBCIOGID(IBCILSEG)
+12 SET IBCIOID(IBCILSEG)=$PIECE(NODE50,U,4)
+13 SET X=IBCIOID(IBCILSEG)
SET X1=20
SET IBCIOID(IBCILSEG)=$$FILL^IBCIUT2
+14 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,22)=IBCIOID(IBCILSEG)
+15 SET IBCILSTA(IBCILSEG)=$$LSTA^IBCIUT1(IBCISNT)
+16 SET X=IBCILSTA(IBCILSEG)
SET X1=3
SET X4="T"
SET IBCILSTA(IBCILSEG)=$$FILL^IBCIUT2
KILL X4
+17 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,23)=IBCILSTA(IBCILSEG)
+18 SET IBCIBDOS(IBCILSEG)=$PIECE(NODE50,U,6)
+19 SET X=IBCIBDOS(IBCILSEG)
SET X1=16
SET IBCIBDOS(IBCILSEG)=$$FILL^IBCIUT2
+20 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,24)=IBCIBDOS(IBCILSEG)
+21 SET IBCIEDOS(IBCILSEG)=$PIECE(NODE50,U,7)
+22 SET X=IBCIEDOS(IBCILSEG)
SET X1=16
SET IBCIEDOS(IBCILSEG)=$$FILL^IBCIUT2
+23 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,25)=IBCIEDOS(IBCILSEG)
+24 SET IBCIPOS(IBCILSEG)=$PIECE(NODE50,U,8)
+25 SET X=IBCIPOS(IBCILSEG)
SET X1=3
SET X4="T"
SET IBCIPOS(IBCILSEG)=$$FILL^IBCIUT2
KILL X4
+26 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,26)=IBCIPOS(IBCILSEG)
+27 SET IBCISPC(IBCILSEG)=$PIECE(NODE50,U,9)
+28 SET X=IBCISPC(IBCILSEG)
SET X1=25
SET IBCISPC(IBCILSEG)=$$FILL^IBCIUT2
+29 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,27)=IBCISPC(IBCILSEG)
+30 SET IBCIAPC(IBCILSEG)=$PIECE(NODE50,U,10)
+31 SET X=IBCIAPC(IBCILSEG)
SET X1=25
SET IBCIAPC(IBCILSEG)=$$FILL^IBCIUT2
+32 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,28)=IBCIAPC(IBCILSEG)
+33 SET IBCISAMT(IBCILSEG)=$PIECE(NODE50,U,11)
+34 ;
+35 ; esg - 7/5/01 - correct the format of the $ amount
+36 SET IBCISAMT(IBCILSEG)=+$TRANSLATE($FNUMBER(IBCISAMT(IBCILSEG),"",2),".")
+37 SET X=IBCISAMT(IBCILSEG)
SET X1=15
SET IBCISAMT(IBCILSEG)=$$FILL^IBCIUT2
+38 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,29)=IBCISAMT(IBCILSEG)
+39 SET IBCIPAC(IBCILSEG)=$PIECE(NODE50,U,12)
+40 SET X=IBCIPAC(IBCILSEG)
SET X1=15
SET IBCIPAC(IBCILSEG)=$$FILL^IBCIUT2
+41 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,30)=IBCIPAC(IBCILSEG)
+42 SET IBCISPID(IBCILSEG)=$PIECE(NODE50,U,13)
+43 SET X=IBCISPID(IBCILSEG)
SET X1=20
SET IBCISPID(IBCILSEG)=$$FILL^IBCIUT2
+44 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,31)=IBCISPID(IBCILSEG)
+45 SET IBCISPLA(IBCILSEG)=$PIECE(NODE51,U,1)
+46 SET X=IBCISPLA(IBCILSEG)
SET X1=40
SET IBCISPLA(IBCILSEG)=$$FILL^IBCIUT2
+47 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,32)=IBCISPLA(IBCILSEG)
+48 SET IBCISPMI(IBCILSEG)=$PIECE(NODE51,U,2)
+49 SET X=IBCISPMI(IBCILSEG)
SET X1=20
SET IBCISPMI(IBCILSEG)=$$FILL^IBCIUT2
+50 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,33)=IBCISPMI(IBCILSEG)
+51 SET IBCISPFI(IBCILSEG)=$PIECE(NODE51,U,3)
+52 SET X=IBCISPFI(IBCILSEG)
SET X1=20
SET IBCISPFI(IBCILSEG)=$$FILL^IBCIUT2
+53 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,34)=IBCISPFI(IBCILSEG)
+54 SET IBCISPTI(IBCILSEG)=$PIECE(NODE51,U,4)
+55 SET X=IBCISPTI(IBCILSEG)
SET X1=5
SET X4="T"
SET IBCISPTI(IBCILSEG)=$$FILL^IBCIUT2
KILL X4
+56 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,35)=IBCISPTI(IBCILSEG)
+57 SET IBCISPDE(IBCILSEG)=$PIECE(NODE51,U,5)
+58 SET X=IBCISPDE(IBCILSEG)
SET X1=20
SET IBCISPDE(IBCILSEG)=$$FILL^IBCIUT2
+59 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,36)=IBCISPDE(IBCILSEG)
+60 SET IBCISPSP(IBCILSEG)=$PIECE(NODE51,U,6)
+61 SET X=IBCISPSP(IBCILSEG)
SET X1=10
SET IBCISPSP(IBCILSEG)=$$FILL^IBCIUT2
+62 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,37)=IBCISPSP(IBCILSEG)
+63 SET IBCISPDI(IBCILSEG)=$PIECE(NODE51,U,7)
+64 SET X=IBCISPDI(IBCILSEG)
SET X1=10
SET IBCISPDI(IBCILSEG)=$$FILL^IBCIUT2
+65 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,38)=IBCISPDI(IBCILSEG)
+66 SET IBCISPUP(IBCILSEG)=$PIECE(NODE51,U,8)
+67 SET X=IBCISPUP(IBCILSEG)
SET X1=10
SET IBCISPUP(IBCILSEG)=$$FILL^IBCIUT2
+68 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,39)=IBCISPUP(IBCILSEG)
+69 SET IBCIBPID(IBCILSEG)=$PIECE(NODE51,U,9)
+70 SET X=IBCIBPID(IBCILSEG)
SET X1=20
SET IBCIBPID(IBCILSEG)=$$FILL^IBCIUT2
+71 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,40)=IBCIBPID(IBCILSEG)
+72 SET IBCIBPLA(IBCILSEG)=$PIECE(NODE52,U,1)
+73 SET X=IBCIBPLA(IBCILSEG)
SET X1=40
SET IBCIBPLA(IBCILSEG)=$$FILL^IBCIUT2
+74 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,41)=IBCIBPLA(IBCILSEG)
+75 SET IBCIBPMI(IBCILSEG)=$PIECE(NODE52,U,2)
+76 SET X=IBCIBPMI(IBCILSEG)
SET X1=20
SET IBCIBPMI(IBCILSEG)=$$FILL^IBCIUT2
+77 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,42)=IBCIBPMI(IBCILSEG)
+78 SET IBCIBPFI(IBCILSEG)=$PIECE(NODE52,U,3)
+79 SET X=IBCIBPFI(IBCILSEG)
SET X1=20
SET IBCIBPFI(IBCILSEG)=$$FILL^IBCIUT2
+80 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,43)=IBCIBPFI(IBCILSEG)
+81 SET IBCIBPTI(IBCILSEG)=$PIECE(NODE52,U,4)
+82 SET X=IBCIBPTI(IBCILSEG)
SET X1=5
SET X4="T"
SET IBCIBPTI(IBCILSEG)=$$FILL^IBCIUT2
KILL X4
+83 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,44)=IBCIBPTI(IBCILSEG)
+84 SET IBCIBPDE(IBCILSEG)=$PIECE(NODE52,U,5)
+85 SET X=IBCIBPDE(IBCILSEG)
SET X1=20
SET X4="T"
SET IBCIBPDE(IBCILSEG)=$$FILL^IBCIUT2
KILL X4
+86 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,45)=IBCIBPDE(IBCILSEG)
+87 SET IBCIBPSP(IBCILSEG)=$PIECE(NODE52,U,6)
+88 SET X=IBCIBPSP(IBCILSEG)
SET X1=10
SET IBCIBPSP(IBCILSEG)=$$FILL^IBCIUT2
+89 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,46)=IBCIBPSP(IBCILSEG)
+90 SET IBCIBPDI(IBCILSEG)=$PIECE(NODE52,U,7)
+91 SET X=IBCIBPDI(IBCILSEG)
SET X1=10
SET IBCIBPDI(IBCILSEG)=$$FILL^IBCIUT2
+92 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,47)=IBCIBPDI(IBCILSEG)
+93 SET IBCIBPUP(IBCILSEG)=$PIECE(NODE52,U,8)
+94 SET X=IBCIBPUP(IBCILSEG)
SET X1=10
SET IBCIBPUP(IBCILSEG)=$$FILL^IBCIUT2
+95 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,48)=IBCIBPUP(IBCILSEG)
+96 SET IBCIPPID(IBCILSEG)=$PIECE(NODE52,U,9)
+97 SET X=IBCIPPID(IBCILSEG)
SET X1=20
SET IBCIPPID(IBCILSEG)=$$FILL^IBCIUT2
+98 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,49)=IBCIPPID(IBCILSEG)
+99 SET IBCISPAI(IBCILSEG)=$PIECE(NODE52,U,10)
+100 SET X=IBCISPAI(IBCILSEG)
SET X1=20
SET IBCISPAI(IBCILSEG)=$$FILL^IBCIUT2
+101 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,50)=IBCISPAI(IBCILSEG)
+102 SET IBCITOS(IBCILSEG)=$PIECE(NODE52,U,11)
+103 SET X=IBCITOS(IBCILSEG)
SET X1=3
SET X4="T"
SET IBCITOS(IBCILSEG)=$$FILL^IBCIUT2
KILL X4
+104 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,51)=IBCITOS(IBCILSEG)
+105 SET IBCIUNIT(IBCILSEG)=$PIECE(NODE52,U,12)
+106 SET X=IBCIUNIT(IBCILSEG)
SET X1=5
SET X4="T"
SET IBCIUNIT(IBCILSEG)=$$FILL^IBCIUT2
KILL X4
+107 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,52)=IBCIUNIT(IBCILSEG)
CPT ;get cpt modifiers
+1 SET IBCICPT(IBCILSEG,0)=$PIECE($GET(^IBA(351.9,IBIFN,5,IBCILSEG,3)),U)
+2 IF IBCICPT(IBCILSEG,0)[","
FOR I=1:1
if $PIECE(IBCICPT(IBCILSEG,0),",",I)']""
QUIT
Begin DoDot:2
+3 SET IBCICPT(IBCILSEG,I)=$PIECE(IBCICPT(IBCILSEG,0),",",I)
End DoDot:2
+4 IF '$TEST
SET IBCICPT(IBCILSEG,1)=IBCICPT(IBCILSEG,0)
+5 SET (CT,I)=0
FOR
SET I=$ORDER(IBCICPT(IBCILSEG,I))
if 'I
QUIT
Begin DoDot:2
+6 SET X=IBCICPT(IBCILSEG,I)
DO CCK^IBCIUT4()
DO TCK^IBCIUT4()
+7 SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,54,I)=IBCICPT(IBCILSEG,I)
+8 SET CT=CT+1
SET ^TMP("IBCIMSG",$JOB,IBIFN,IBCICLNP,IBCILSEG,54,0)=CT_U
End DoDot:2
End DoDot:1
Q QUIT
