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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRHL7U 2241 printed Nov 22, 2024@17:44:57 Page 2
RMPRHL7U ;HINES CIOFO/HNC - Utilities for HL7 messages ;3/14/00
+1 ;;3.0;PROSTHETICS;**45,78**;Feb 09, 1996
+2 ;
+3 ;Patch #78 09/26/03 TH - Add field desc for PV1 & ZCL segments.
+4 ; - Clean up DG1 related variables.
+5 QUIT
+6 ;
PID(RMPRPID) ;Get fields from PID segment and set into RMPR variables.
+1 SET DFN=$PIECE(RMPRPID,"|",4)
SET RMPRPNM=$PIECE(RMPRPID,"|",6)
+2 QUIT
+3 ;
PV1(RMPRPV1) ;
+1 ;Get fields from PV1 segment of HL-7 message and set into RMPR variables
+2 NEW X
+3 ; RMPRSBR = service basis to be rendered (Inpatient or Outpatient)
+4 SET X=$PIECE(RMPRPV1,"|",3)
SET RMPRSBR=$SELECT(X]"":X,1:"")
+5 ;
+6 ; Patient Location
+7 ; Inpatient: Hospital Location IEN^Room-Bed
+8 ; Outpatinet: Hospital Location IEN
+9 ; RMPRWARD=patients ward
+10 SET X=$PIECE(RMPRPV1,"|",4)
SET RMPRWARD=$SELECT($PIECE(X,"^",1)]"":$PIECE(X,"^",1),1:"")
+11 ; RMPRRB = patients room/bed
+12 SET RMPRRB=$SELECT($PIECE(X,"^",2)]"":$PIECE(X,"^",2),1:"")
+13 ;
+14 ; Outpatient: VISIT=Pointer for the Visit file (#9000010)
+15 SET VISIT=$SELECT($PIECE(RMPRPV1,"|",20)]"":$PIECE(RMPRPV1,"|",20),1:"")
+16 NEW RMPRVSIT
if VISIT]""
SET RMPRVSIT=$$FMDATE^RMPRHL7(VISIT)
+17 QUIT
+18 ;
REJECT(RMPRMSG) ;can't be filed send reject message
+1 ;
+2 ;send message to mail group RMPR SUSP
+3 NEW XMDUZ
+4 SET XMDUZ=.5
+5 SET XMTEXT="RMPRMSG("
+6 SET XMSUB="Request Failed to Suspense"
+7 SET XMY("RMPR SUSP")=""
+8 DO ^XMD
+9 QUIT
+10 ;
FILE(RMPRO,DR) ;File data "^"RMPR(668,IEN,4 using "^"DIE
+1 NEW DIE,DA
+2 ;RMPRO = IEN
+3 LOCK +^RMPR(668,+RMPRO,4)
if '$DATA(^RMPR(668,+RMPRO,4,0))
SET ^(0)="^668.02DA^^"
+4 SET DA=$SELECT($PIECE(^RMPR(668,+RMPRO,4,0),"^",3):$PIECE(^(0),"^",3)+1,1:1)
SET DA(1)=+RMPRO
+5 SET DIE="^RMPR(668,"_RMPRO_",4,"
+6 SET $PIECE(^RMPR(668,+RMPRO,4,0),"^",3,4)=DA_"^"_DA
+7 DO ^DIE
+8 LOCK -^RMPR(668,+RMPRO,4)
+9 QUIT
+10 ;
EXIT ;Kill variables and exit
+1 KILL HLQ,J,LN,ND,ND1,ND2
+2 KILL RMPRA,RMPRACT,RMPRAD,RMPRAP,RMPRAPP,RMPRATN,RMPRDA,RMPRDEV,RMPRFAC
+3 KILL RMPRFF,RMPRINTR,RMPRMTP,RMPRMSG,RMPRMSH,RMPRNOD,RMPRNTC,RMPRODT
+4 KILL RMPROID,RMPRORFN,RMPRPA,RMPRPLCR,RMPRPLI,RMPRPNM,RMPRPR,RMPRPRI,RMPRFQ
+5 KILL RMPRPRDG,RMPRSEND,RMPRSTDT,RMPRSTS,RMPRURGI,RMPRVAL,RMPRVTYP,RMPRWARD
+6 KILL RMPRPRV,RMPRTYPE,RMPRND,RMPRND1,VISIT
+7 KILL RMPRRB,RMPRPRA,RMPRRFQ,MSH,OBXND,PID,RMPRORPV,RMPROTXT
+8 KILL RMPRTRLC,RMPRSS,RMPRO,RMPRORNP
+9 KILL RMPRGMRC,RMPRCD,RMPRNATO,RMPRQT,RMPRS38,RMPRS668
+10 KILL DA,DIC
+11 KILL RMPRMSG,RMPRCI,RMPRSID,RMPRDIAG,RMPRDG1
+12 QUIT
+13 ;END
