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 Dec 13, 2024@02:15:53 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
