source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCORMN01.m@ 823

Last change on this file since 823 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1MCORMN01 ;WISC/DCB-HL7 MESSAGE BUILDER PART 2 ;5/2/96 13:30
2 ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
3 ; Reference IA #10106 for HLFNC calls.
4 ; #10061 for VADPT call.
5 W !,"This is not a valid entry point" Q
6MSH(PROC,SAP,SNF,RAP,RNF,MST,PCI,VID) ;MSH Messaging Line
7 N MSH,Y,%,%I
8 D NOW^%DTC
9 S $P(MSH,ST(1),8)=$$CONVERT("D",%)
10 S MSH="MSH"_MSTR,$P(MSH,ST(1),3)=PROC_ST(2)_SAP,$P(MSH,ST(1),4)=SNF
11 S $P(MSH,ST(1),5)=RAP,$P(MSH,ST(1),6)=RNF,$P(MSH,ST(1),9)=MST
12 S $P(MSH,ST(1),10)=PCI,$P(MSH,ST(1),11)=VID
13 Q MSH
14PID(DFN) ;PID Messaging Line
15 N PID,VADM,SSN,PTN,DOB,SEX,LOOP
16 D DEM^VADPT
17 S SSN=$$M11^HLFNC($P(VADM(2),U,1)),PTN=$$CONVERT("P200",VADM(1))
18 S DOB=$$CONVERT("D",$P(VADM(3),U))
19 S SEX=$P(VADM(5),U)
20 S PID="PID",$P(PID,ST(1),4)=SSN
21 S $P(PID,ST(1),7)=PTN,$P(PID,ST(1),8)=DOB,$P(PID,ST(1),9)=SEX
22 Q PID
23OBX1(FILETYPE,VTI,OBI,OSI,OBR) ; ODX Messaging Line
24 N OBX
25 S OBR=$$CONVERT(FILETYPE,OBR)
26 S OBX="OBX",$P(OBX,ST(1),3)=VTI
27 S $P(OBX,ST(1),4)=OBI,$P(OBX,ST(1),5)=OSI,$P(OBX,ST(1),6)=OBR
28 Q OBX
29OBX2(UNT,RNG) ; ODX Messaging Line
30 N OBX
31 S OBX=""
32 S $P(OBX,ST(1),2)=UNT,$P(OBX,ST(1),3)=RNG
33 Q OBX
34OBR1(SDATE,MCPROC,REC,FILE) ; OBX Messaging Line
35 N LOOP,TEMP,TMP,STAT,STR
36 S TMP=+$O(^MCAR(697.2,"B",MCPROC,""))
37 S:'TMP TMP=$P($G(^MCAR(697.2,TMP,0)),U,4)
38 S TMP=$S(TMP="C":"EC",TMP="H":"HM",TMP["P":"PF",1:"OTH")
39 S STAT=$P($G(^MCAR(MCFILE,REC,"ES")),U,7)
40 S STAT=$S(STAT="RNV":"R",STAT="RV":"F",STAT="ROV":"F",STAT["D":"P",1:"")
41 S TEMP=$$CONVERT("D",SDATE),STR="OBR",$P(STR,ST(1),8)=TEMP
42 S $P(STR,ST(1),16)=TMP,$P(STR,ST(1),26)=STAT
43 Q STR
44CONVERT(FILETYPE,RST) ;Convert Fileman to HL7
45 N TEMP
46 S TEMP=RST
47 I FILETYPE["D" D
48 .S TEMP=$$HLDATE^HLFNC(RST,"TS")
49 S:(FILETYPE["P200")!(FILETYPE["P690") TEMP=$$HLNAME^HLFNC(RST)
50 Q TEMP
Note: See TracBrowser for help on using the repository browser.