VistA-WorldVistAEHR/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRHL7U.m

67 lines
2.1 KiB
Mathematica
Raw Permalink Normal View History

2009-11-29 13:37:14 -05:00
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