67 lines
2.1 KiB
Mathematica
67 lines
2.1 KiB
Mathematica
RMPRHL7U ;HINES CIOFO/HNC - Utilities for HL7 messages ;3/14/00
|
|
;;3.0;PROSTHETICS;**45,78**;Feb 09, 1996
|
|
;
|
|
;Patch #78 09/26/03 TH - Add field desc for PV1 & ZCL segments.
|
|
; - Clean up DG1 related variables.
|
|
Q
|
|
;
|
|
PID(RMPRPID) ;Get fields from PID segment and set into RMPR variables.
|
|
S DFN=$P(RMPRPID,"|",4),RMPRPNM=$P(RMPRPID,"|",6)
|
|
Q
|
|
;
|
|
PV1(RMPRPV1) ;
|
|
;Get fields from PV1 segment of HL-7 message and set into RMPR variables
|
|
N X
|
|
; RMPRSBR = service basis to be rendered (Inpatient or Outpatient)
|
|
S X=$P(RMPRPV1,"|",3),RMPRSBR=$S(X]"":X,1:"")
|
|
;
|
|
; Patient Location
|
|
; Inpatient: Hospital Location IEN^Room-Bed
|
|
; Outpatinet: Hospital Location IEN
|
|
; RMPRWARD=patients ward
|
|
S X=$P(RMPRPV1,"|",4),RMPRWARD=$S($P(X,"^",1)]"":$P(X,"^",1),1:"")
|
|
; RMPRRB = patients room/bed
|
|
S RMPRRB=$S($P(X,"^",2)]"":$P(X,"^",2),1:"")
|
|
;
|
|
; Outpatient: VISIT=Pointer for the Visit file (#9000010)
|
|
S VISIT=$S($P(RMPRPV1,"|",20)]"":$P(RMPRPV1,"|",20),1:"")
|
|
N RMPRVSIT S:VISIT]"" RMPRVSIT=$$FMDATE^RMPRHL7(VISIT)
|
|
Q
|
|
;
|
|
REJECT(RMPRMSG) ;can't be filed send reject message
|
|
;
|
|
;send message to mail group RMPR SUSP
|
|
N XMDUZ
|
|
S XMDUZ=.5
|
|
S XMTEXT="RMPRMSG("
|
|
S XMSUB="Request Failed to Suspense"
|
|
S XMY("RMPR SUSP")=""
|
|
D ^XMD
|
|
Q
|
|
;
|
|
FILE(RMPRO,DR) ;File data "^"RMPR(668,IEN,4 using "^"DIE
|
|
N DIE,DA
|
|
;RMPRO = IEN
|
|
L +^RMPR(668,+RMPRO,4) S:'$D(^RMPR(668,+RMPRO,4,0)) ^(0)="^668.02DA^^"
|
|
S DA=$S($P(^RMPR(668,+RMPRO,4,0),"^",3):$P(^(0),"^",3)+1,1:1),DA(1)=+RMPRO
|
|
S DIE="^RMPR(668,"_RMPRO_",4,"
|
|
S $P(^RMPR(668,+RMPRO,4,0),"^",3,4)=DA_"^"_DA
|
|
D ^DIE
|
|
L -^RMPR(668,+RMPRO,4)
|
|
Q
|
|
;
|
|
EXIT ;Kill variables and exit
|
|
K HLQ,J,LN,ND,ND1,ND2
|
|
K RMPRA,RMPRACT,RMPRAD,RMPRAP,RMPRAPP,RMPRATN,RMPRDA,RMPRDEV,RMPRFAC
|
|
K RMPRFF,RMPRINTR,RMPRMTP,RMPRMSG,RMPRMSH,RMPRNOD,RMPRNTC,RMPRODT
|
|
K RMPROID,RMPRORFN,RMPRPA,RMPRPLCR,RMPRPLI,RMPRPNM,RMPRPR,RMPRPRI,RMPRFQ
|
|
K RMPRPRDG,RMPRSEND,RMPRSTDT,RMPRSTS,RMPRURGI,RMPRVAL,RMPRVTYP,RMPRWARD
|
|
K RMPRPRV,RMPRTYPE,RMPRND,RMPRND1,VISIT
|
|
K RMPRRB,RMPRPRA,RMPRRFQ,MSH,OBXND,PID,RMPRORPV,RMPROTXT
|
|
K RMPRTRLC,RMPRSS,RMPRO,RMPRORNP
|
|
K RMPRGMRC,RMPRCD,RMPRNATO,RMPRQT,RMPRS38,RMPRS668
|
|
K DA,DIC
|
|
K RMPRMSG,RMPRCI,RMPRSID,RMPRDIAG,RMPRDG1
|
|
Q
|
|
;END
|