- MCORMN01 ;WISC/DCB-HL7 MESSAGE BUILDER PART 2 ;5/2/96 13:30
- ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
- ; Reference IA #10106 for HLFNC calls.
- ; #10061 for VADPT call.
- W !,"This is not a valid entry point" Q
- MSH(PROC,SAP,SNF,RAP,RNF,MST,PCI,VID) ;MSH Messaging Line
- N MSH,Y,%,%I
- D NOW^%DTC
- S $P(MSH,ST(1),8)=$$CONVERT("D",%)
- S MSH="MSH"_MSTR,$P(MSH,ST(1),3)=PROC_ST(2)_SAP,$P(MSH,ST(1),4)=SNF
- S $P(MSH,ST(1),5)=RAP,$P(MSH,ST(1),6)=RNF,$P(MSH,ST(1),9)=MST
- S $P(MSH,ST(1),10)=PCI,$P(MSH,ST(1),11)=VID
- Q MSH
- PID(DFN) ;PID Messaging Line
- N PID,VADM,SSN,PTN,DOB,SEX,LOOP
- D DEM^VADPT
- S SSN=$$M11^HLFNC($P(VADM(2),U,1)),PTN=$$CONVERT("P200",VADM(1))
- S DOB=$$CONVERT("D",$P(VADM(3),U))
- S SEX=$P(VADM(5),U)
- S PID="PID",$P(PID,ST(1),4)=SSN
- S $P(PID,ST(1),7)=PTN,$P(PID,ST(1),8)=DOB,$P(PID,ST(1),9)=SEX
- Q PID
- OBX1(FILETYPE,VTI,OBI,OSI,OBR) ; ODX Messaging Line
- N OBX
- S OBR=$$CONVERT(FILETYPE,OBR)
- S OBX="OBX",$P(OBX,ST(1),3)=VTI
- S $P(OBX,ST(1),4)=OBI,$P(OBX,ST(1),5)=OSI,$P(OBX,ST(1),6)=OBR
- Q OBX
- OBX2(UNT,RNG) ; ODX Messaging Line
- N OBX
- S OBX=""
- S $P(OBX,ST(1),2)=UNT,$P(OBX,ST(1),3)=RNG
- Q OBX
- OBR1(SDATE,MCPROC,REC,FILE) ; OBX Messaging Line
- N LOOP,TEMP,TMP,STAT,STR
- S TMP=+$O(^MCAR(697.2,"B",MCPROC,""))
- S:'TMP TMP=$P($G(^MCAR(697.2,TMP,0)),U,4)
- S TMP=$S(TMP="C":"EC",TMP="H":"HM",TMP["P":"PF",1:"OTH")
- S STAT=$P($G(^MCAR(MCFILE,REC,"ES")),U,7)
- S STAT=$S(STAT="RNV":"R",STAT="RV":"F",STAT="ROV":"F",STAT["D":"P",1:"")
- S TEMP=$$CONVERT("D",SDATE),STR="OBR",$P(STR,ST(1),8)=TEMP
- S $P(STR,ST(1),16)=TMP,$P(STR,ST(1),26)=STAT
- Q STR
- CONVERT(FILETYPE,RST) ;Convert Fileman to HL7
- N TEMP
- S TEMP=RST
- I FILETYPE["D" D
- .S TEMP=$$HLDATE^HLFNC(RST,"TS")
- S:(FILETYPE["P200")!(FILETYPE["P690") TEMP=$$HLNAME^HLFNC(RST)
- Q TEMP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCORMN01 1820 printed Feb 18, 2025@23:42:21 Page 2
- MCORMN01 ;WISC/DCB-HL7 MESSAGE BUILDER PART 2 ;5/2/96 13:30
- +1 ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
- +2 ; Reference IA #10106 for HLFNC calls.
- +3 ; #10061 for VADPT call.
- +4 WRITE !,"This is not a valid entry point"
- QUIT
- MSH(PROC,SAP,SNF,RAP,RNF,MST,PCI,VID) ;MSH Messaging Line
- +1 NEW MSH,Y,%,%I
- +2 DO NOW^%DTC
- +3 SET $PIECE(MSH,ST(1),8)=$$CONVERT("D",%)
- +4 SET MSH="MSH"_MSTR
- SET $PIECE(MSH,ST(1),3)=PROC_ST(2)_SAP
- SET $PIECE(MSH,ST(1),4)=SNF
- +5 SET $PIECE(MSH,ST(1),5)=RAP
- SET $PIECE(MSH,ST(1),6)=RNF
- SET $PIECE(MSH,ST(1),9)=MST
- +6 SET $PIECE(MSH,ST(1),10)=PCI
- SET $PIECE(MSH,ST(1),11)=VID
- +7 QUIT MSH
- PID(DFN) ;PID Messaging Line
- +1 NEW PID,VADM,SSN,PTN,DOB,SEX,LOOP
- +2 DO DEM^VADPT
- +3 SET SSN=$$M11^HLFNC($PIECE(VADM(2),U,1))
- SET PTN=$$CONVERT("P200",VADM(1))
- +4 SET DOB=$$CONVERT("D",$PIECE(VADM(3),U))
- +5 SET SEX=$PIECE(VADM(5),U)
- +6 SET PID="PID"
- SET $PIECE(PID,ST(1),4)=SSN
- +7 SET $PIECE(PID,ST(1),7)=PTN
- SET $PIECE(PID,ST(1),8)=DOB
- SET $PIECE(PID,ST(1),9)=SEX
- +8 QUIT PID
- OBX1(FILETYPE,VTI,OBI,OSI,OBR) ; ODX Messaging Line
- +1 NEW OBX
- +2 SET OBR=$$CONVERT(FILETYPE,OBR)
- +3 SET OBX="OBX"
- SET $PIECE(OBX,ST(1),3)=VTI
- +4 SET $PIECE(OBX,ST(1),4)=OBI
- SET $PIECE(OBX,ST(1),5)=OSI
- SET $PIECE(OBX,ST(1),6)=OBR
- +5 QUIT OBX
- OBX2(UNT,RNG) ; ODX Messaging Line
- +1 NEW OBX
- +2 SET OBX=""
- +3 SET $PIECE(OBX,ST(1),2)=UNT
- SET $PIECE(OBX,ST(1),3)=RNG
- +4 QUIT OBX
- OBR1(SDATE,MCPROC,REC,FILE) ; OBX Messaging Line
- +1 NEW LOOP,TEMP,TMP,STAT,STR
- +2 SET TMP=+$ORDER(^MCAR(697.2,"B",MCPROC,""))
- +3 if 'TMP
- SET TMP=$PIECE($GET(^MCAR(697.2,TMP,0)),U,4)
- +4 SET TMP=$SELECT(TMP="C":"EC",TMP="H":"HM",TMP["P":"PF",1:"OTH")
- +5 SET STAT=$PIECE($GET(^MCAR(MCFILE,REC,"ES")),U,7)
- +6 SET STAT=$SELECT(STAT="RNV":"R",STAT="RV":"F",STAT="ROV":"F",STAT["D":"P",1:"")
- +7 SET TEMP=$$CONVERT("D",SDATE)
- SET STR="OBR"
- SET $PIECE(STR,ST(1),8)=TEMP
- +8 SET $PIECE(STR,ST(1),16)=TMP
- SET $PIECE(STR,ST(1),26)=STAT
- +9 QUIT STR
- CONVERT(FILETYPE,RST) ;Convert Fileman to HL7
- +1 NEW TEMP
- +2 SET TEMP=RST
- +3 IF FILETYPE["D"
- Begin DoDot:1
- +4 SET TEMP=$$HLDATE^HLFNC(RST,"TS")
- End DoDot:1
- +5 if (FILETYPE["P200")!(FILETYPE["P690")
- SET TEMP=$$HLNAME^HLFNC(RST)
- +6 QUIT TEMP
