MCORMN01.m

MCORMN01 ;WISC/DCB-HL7 MESSAGE BUILDER PART 2 ;5/2/96  13:30

 ;;2.3;Medicine;;09/13/1996

 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 ^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

MCORMN01  ;WISC/DCB-HL7 MESSAGE BUILDER PART 2 ;5/2/96  13:30

 +1       ;;2.3;Medicine;;09/13/1996

 +2        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 ^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