| 1 | MCORMN0 ;WISC/DCB-HL7 MESSAGE BUILDER ;7/23/99 09:08
|
---|
| 2 | ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
|
---|
| 3 | W !,"This is not a valid entry point" Q
|
---|
| 4 | BUILD(RAP,MCDFN,SAP,SNF,RNF,MST,PCI,VID,MCLINE,MSTR,MCDEST,MCPROC,MCFILE,MCREC,SDATE,ATYPE) ; Build the message
|
---|
| 5 | K ^TMP("MCORMN",$J)
|
---|
| 6 | N MCERR,MCOR,MCOR1,MCOR2,MCOR3,MCOR4,MSE,OBR,HLECH
|
---|
| 7 | N LOOP,MCDS,ST,MSE,MCHOLD,MCHOLD
|
---|
| 8 | S MSE=0,HLECH=$E(MSTR,2,4) D SLIP(MSTR)
|
---|
| 9 | S MCHOLD=+$O(^MCAR(697.2,"B",MCPROC,""))
|
---|
| 10 | S MCHOLD=$P($G(^MCAR(697.2,MCHOLD,0)),U,8)
|
---|
| 11 | S MCERR=$$GETDATA^MCORMN1(MCPROC,MCREC,"^TMP(""MCORMN"",$J)",MCFILE,ATYPE) Q:MCERR=0 1
|
---|
| 12 | S MCHOLD=$S(MCHOLD="":MCPROC,1:MCHOLD)
|
---|
| 13 | D SETNODE(MCDEST,$$MSH^MCORMN01(MCHOLD,SAP,SNF,RAP,RNF,MST,PCI,VID))
|
---|
| 14 | D SETNODE(MCDEST,$$PID^MCORMN01(MCDFN))
|
---|
| 15 | D SETNODE(MCDEST,$$OBR1^MCORMN01(SDATE,MCPROC,MCREC,MCFILE)) S OBR=MCLINE
|
---|
| 16 | S MCOR1=""
|
---|
| 17 | F S MCOR1=$O(^TMP("MCORMN",$J,"E",MCOR1)) Q:MCOR1="" D
|
---|
| 18 | .S MCOR2=""
|
---|
| 19 | .F S MCOR2=$O(^TMP("MCORMN",$J,"E",MCOR1,MCOR2)) Q:MCOR2="" D
|
---|
| 20 | ..S MCOR3=""
|
---|
| 21 | ..F S MCOR3=$O(^TMP("MCORMN",$J,"E",MCOR1,MCOR2,MCOR3)) Q:MCOR3="" D
|
---|
| 22 | ...D GETDATA(RAP,MCDEST,OBR,MCOR1,MCOR2,MCOR3)
|
---|
| 23 | I +$P($G(^MCAR(MCFILE,MCREC,2005,0)),U,4)>0 D
|
---|
| 24 | .N OBI,OBR,OSI,VTI,UNT,RNG
|
---|
| 25 | .S OBI=MCFILE_ST(3)_"2005"_ST(3)_"P"_ST(2)_"IMAGES?"_ST(2)_"DD"
|
---|
| 26 | .S OBR="Images are associated with this procedure"
|
---|
| 27 | .S OSI="",VTI="",FILETYPE="P",UNT="",RNG=""
|
---|
| 28 | .D SETOBX1(FILETYPE,VTI,OBI,OSI,OBR),SETOBX2(UNT,RNG)
|
---|
| 29 | Q 0
|
---|
| 30 | GETDATA(RAP,MCDEST,OBR,MCOR1,MCOR2,MCOR3) ; Process the Data
|
---|
| 31 | N TMP1,TMP,HL7,TYPE
|
---|
| 32 | S TMP=$G(^TMP("MCORMN",$J,"F",MCOR1,MCOR3,0))
|
---|
| 33 | S HL7=$G(^TMP("MCORMN",$J,"F",MCOR1,MCOR3,1))
|
---|
| 34 | S TYPE=$P(HL7,U,7)
|
---|
| 35 | I (TYPE'="OBR"),(TYPE'="INFO"),(RAP="Health Summary") S TYPE="DD"
|
---|
| 36 | Q:(TYPE="INFO")!(TYPE="MISC")!(TYPE="")
|
---|
| 37 | S TMP1="D "_TYPE_"(TMP,HL7,OBR,MCOR1,MCOR2,MCOR3)" X TMP1
|
---|
| 38 | Q
|
---|
| 39 | ICD9(TMP,HL7,OBX,MCOR1,MCOR2,MCOR3) ; This is the ICD9 message builder for OBX
|
---|
| 40 | N OID,VT1,UNT,OSI,OBI,RNG,RST,DA,DIC,DR,DIQ,XTMP,CONT
|
---|
| 41 | S OBI="ICD9",OSI="",MST=$G(MST)+1,OSI=MST,CONT=""
|
---|
| 42 | S VTI=$P(HL7,U,2) S:VTI="" VTI="CE"
|
---|
| 43 | S UNT="",RNG="",RST=$G(^TMP("MCORMN",$J,"E",MCOR1,MCOR2,MCOR3,1)) Q:RST=""
|
---|
| 44 | ;S DA=$O(^ICD9("B",RST,"")) Q:DA=""
|
---|
| 45 | Q
|
---|
| 46 | S DIC="^ICD9(",DR=".01;3",DIQ="XTMP(" D EN^DIQ1
|
---|
| 47 | S RST=XTMP(80,DA,.01)_ST(2)_XTMP(80,DA,3)_ST(2)_"ICD9"
|
---|
| 48 | D SETOBX1("",VTI,OBI,OSI,RST)
|
---|
| 49 | Q
|
---|
| 50 | ASTM(TMP,HL7,OBX,MCOR1,MCOR2,MCOR3) ; This is the ASTM message builder for OBX
|
---|
| 51 | N ASTM,ASTME,VTI,UNT,RNG,RST,OSI,OBI,FILETYPE
|
---|
| 52 | S FILETYPE=$P(TMP,U,2),OSI=""
|
---|
| 53 | S ASTM=$P(HL7,U,1),ASTME=$G(^MCAR(690.5,ASTM,0))
|
---|
| 54 | S ASTM=$P(ASTME,U,1)_$P(ASTME,U,2),VTI=$P(HL7,U,2)
|
---|
| 55 | S OBI=ASTM_ST(2)_$P(ASTME,U,3)_ST(2)_"CPT4"
|
---|
| 56 | S UNT=$P(HL7,U,3),RNG=$P(HL7,U,4)
|
---|
| 57 | D RDATA(VTI,OBI,OSI,UNT,RNG,FILETYPE,MCOR1,MCOR2,MCOR3)
|
---|
| 58 | Q
|
---|
| 59 | SUM(TMP,HL7,OBX,MCOR1,MCOR2,MCOR3) ; This is the miss. message builder for OBX
|
---|
| 60 | N FILETYPE,VTI,UNT,RNG,RST,OSI,OBI
|
---|
| 61 | S FILETYPE=$P(TMP,U,2),OSI=""
|
---|
| 62 | S OBI="SST",(UNT,RNG)="",OSI=""
|
---|
| 63 | S VTI="TX"
|
---|
| 64 | D RDATA(VTI,OBI,OSI,UNT,RNG,FILETYPE,MCOR1,MCOR2,MCOR3)
|
---|
| 65 | Q
|
---|
| 66 | DD(TMP,HL7,OBX,MCOR1,MCOR2,MCOR3) ; This is the DD mesage builder for OBX
|
---|
| 67 | N FLDNAME,VTI,OBI,OSI,UNT,RNG,FILETYPE,FLDNAME
|
---|
| 68 | S FILETYPE=$P(TMP,U,2),FLDNAME=$P(TMP,"^",1),OSI=""
|
---|
| 69 | S VTI=$P(HL7,U,2),OBI=MCOR1_ST(3)_MCOR3_ST(3)_FILETYPE_ST(2)_FLDNAME_ST(2)_"DD"
|
---|
| 70 | S UNT=$P(HL7,U,3),RNG=$P(HL7,U,4)
|
---|
| 71 | D RDATA(VTI,OBI,OSI,UNT,RNG,FILETYPE,MCOR1,MCOR2,MCOR3)
|
---|
| 72 | Q
|
---|
| 73 | OBR(TMP,HL7,OBX,MCOR1,MCOR2,MCOR3) ; This is the OBR add on message
|
---|
| 74 | N RST,PIECE,FILETYPE
|
---|
| 75 | S FILETYPE=$P(TMP,U,2),RST=$G(^TMP("MCORMN",$J,"E",MCOR1,MCOR2,MCOR3,1))
|
---|
| 76 | S RST=$$CONVERT^MCORMN01(FILETYPE,RST),PIECE=$P(HL7,U,6)+1
|
---|
| 77 | S $P(@MCDEST@(OBX),ST(1),PIECE)=RST
|
---|
| 78 | Q
|
---|
| 79 | RDATA(VTI,OBI,OSI,UNT,RNG,FILETYPE,MCOR1,MCOR2,MCOR3) ;
|
---|
| 80 | N MCOR4,CONT,LEN,RSTT,TEMP,COUNT,END,RST,CNT,LOOP,LOOP2,X,DIWL,DIWR,DIWF
|
---|
| 81 | S MCOR4=""
|
---|
| 82 | F LOOP=1:1 S MCOR4=$O(^TMP("MCORMN",$J,"E",MCOR1,MCOR2,MCOR3,MCOR4)) Q:MCOR4="" D
|
---|
| 83 | .S X=^TMP("MCORMN",$J,"E",MCOR1,MCOR2,MCOR3,MCOR4)
|
---|
| 84 | .;I $L(X)>80 D WP
|
---|
| 85 | .I $L(X)>80 D
|
---|
| 86 | ..D WP
|
---|
| 87 | .E D
|
---|
| 88 | ..D:LOOP=1 SETOBX1(FILETYPE,VTI,OBI,OSI,X)
|
---|
| 89 | ..D:LOOP'=1 SETNODE(MCDEST,X)
|
---|
| 90 | D SETOBX2(UNT,RNG)
|
---|
| 91 | Q
|
---|
| 92 | WP ;
|
---|
| 93 | K ^UTILITY($J,"W") S DIWL=0,DIWR=80,DIWF="" D ^DIWP
|
---|
| 94 | S CNT=^UTILITY($J,"W",0)
|
---|
| 95 | F LOOP2=1:1:CNT S RST=^UTILITY($J,"W",0,LOOP2,0) D
|
---|
| 96 | .I (LOOP2>1)!(LOOP>1) D SETNODE(MCDEST,RST)
|
---|
| 97 | .E D SETOBX1(FILETYPE,VTI,OBI,OSI,RST)
|
---|
| 98 | K ^UTILITY($J,"W")
|
---|
| 99 | Q
|
---|
| 100 | SETOBX1(FILETYPE,VTI,OBI,OSI,OBR) ; Sets the first part of QBX line
|
---|
| 101 | S:VTI="" VTI="ST"
|
---|
| 102 | S:OSI="" (MSE,OSI)=$G(MSE)+1
|
---|
| 103 | D SETNODE(MCDEST,$$OBX1^MCORMN01(FILETYPE,VTI,OBI,OSI,OBR))
|
---|
| 104 | Q
|
---|
| 105 | SETOBX2(RNG,UNT) ;Sets the second part of OBX line
|
---|
| 106 | S @MCDEST@(MCLINE,0)=@MCDEST@(MCLINE,0)_$$OBX2^MCORMN01(RNG,UNT)
|
---|
| 107 | Q
|
---|
| 108 | SETNODE(NODE,VALUE) ;Set the node with the HL7 message string
|
---|
| 109 | S MCLINE=MCLINE+1,@NODE@(MCLINE,0)=VALUE
|
---|
| 110 | Q
|
---|
| 111 | SLIP(MSTR) ;Seperate the delimiters
|
---|
| 112 | F LOOP=1:1:5 S ST(LOOP)=$E(MSTR,LOOP,LOOP)
|
---|
| 113 | Q
|
---|