- 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 Apr 23, 2025@18:27:52 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
