ROREVT01 ;HCIOFO/SG - EVENT PROTOCOLS ; 6/9/03 1:50pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; This routine uses the following IAs:
;
; #1181 Subscription to the DGPM MOVEMENT EVENT protocol
; #1298 Subscription to the PXK VISIT DATA EVENT protocol
; #3565 Subscription to the LR7O ALL EVSEND RESULTS protocol
;
Q
;
;***** 'ROR EVENT LAB' PROTOCOL IMPLEMENTATION (DATA AREA #1)
LAB ;
Q:$G(OREMSG)=""
N BUF,DATE,DONE,FS,I,PATIEN
S I="",DONE="00"
F S I=$O(@OREMSG@(I)) Q:I="" D Q:DONE="11"
. S BUF=$G(@OREMSG@(I))
. ;--- Get the HL7 field separator
. I $G(FS)="" S:$E(BUF,1,3)="MSH" FS=$E(BUF,4) Q:$G(FS)=""
. ;--- Get the patient IEN
. I $P(BUF,FS)="PID" D:'$E(DONE,1) Q
. . S PATIEN=+$P(BUF,FS,4) ; PID-3
. . S:PATIEN>0 $E(DONE,1)="1"
. ;--- Get the specimen date
. I $P(BUF,FS)="OBR" D:'$E(DONE,2) Q
. . S DATE=$$HL7TFM^XLFDT($P(BUF,FS,8)) ; OBR-7
. . S $E(DONE,2)="1"
;--- Create the event reference
S:DONE="11" I=$$ADD^RORUPP02(PATIEN,1,DATE)
Q
;
;***** RETURNS THE LIST OF PACKAGE EVENT PROTOCOLS
;
; .EPLST Reference to a local variable. The list of
; package event protocols will be returned via
; this parameter: EPLST(ProtocolName)=""
;
LIST(EPLST) ;
K EPLST
S EPLST("ROR EVENT LAB")=""
S EPLST("ROR EVENT PTF")=""
S EPLST("ROR EVENT VISIT")=""
Q
;
;***** 'ROR EVENT PTF' PROTOCOL IMPLEMENTATION (DATA AREA #3)
PTF ;
N ADATE,IEN405,PATIEN,PDATE,RC,TRC
S PATIEN=$P($G(DGPMA),"^",3) Q:PATIEN'>0
;--- Admissions, transfers and discharges
F TRC=1,2,3 D
. S IEN405=0
. F S IEN405=$O(^UTILITY("DGPM",$J,TRC,IEN405)) Q:IEN405'>0 D
. . S PDATE=$P($G(^UTILITY("DGPM",$J,TRC,IEN405,"P")),"^")
. . S ADATE=$P($G(^UTILITY("DGPM",$J,TRC,IEN405,"A")),"^")
. . I PDATE>0 S RC=$$ADD^RORUPP02(PATIEN,3,PDATE)
. . I ADATE>0 S:ADATE'=PDATE RC=$$ADD^RORUPP02(PATIEN,3,ADATE)
Q
;
;***** 'ROR EVENT VISIT' PROTOCOL IMPLEMENTATION (DATA AREA #2)
VISIT ;
N BUF,IEN,PATIEN,RC,VSIEN
S VSIEN=""
F S VSIEN=$O(^TMP("PXKCO",$J,VSIEN)) Q:VSIEN="" D
. S IEN=""
. F S IEN=$O(^TMP("PXKCO",$J,VSIEN,"VST",IEN)) Q:IEN="" D
. . S BUF=$G(^TMP("PXKCO",$J,VSIEN,"VST",IEN,0,"AFTER"))
. . S PATIEN=$P(BUF,"^",5) Q:(PATIEN'>0)!$P(BUF,"^",11)
. . ;--- Create the event reference
. . S RC=$$ADD^RORUPP02(PATIEN,2,$P(BUF,"^",2))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HROREVT01 2449 printed Sep 23, 2025@19:17:26 Page 2
ROREVT01 ;HCIOFO/SG - EVENT PROTOCOLS ; 6/9/03 1:50pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #1181 Subscription to the DGPM MOVEMENT EVENT protocol
+6 ; #1298 Subscription to the PXK VISIT DATA EVENT protocol
+7 ; #3565 Subscription to the LR7O ALL EVSEND RESULTS protocol
+8 ;
+9 QUIT
+10 ;
+11 ;***** 'ROR EVENT LAB' PROTOCOL IMPLEMENTATION (DATA AREA #1)
LAB ;
+1 if $GET(OREMSG)=""
QUIT
+2 NEW BUF,DATE,DONE,FS,I,PATIEN
+3 SET I=""
SET DONE="00"
+4 FOR
SET I=$ORDER(@OREMSG@(I))
if I=""
QUIT
Begin DoDot:1
+5 SET BUF=$GET(@OREMSG@(I))
+6 ;--- Get the HL7 field separator
+7 IF $GET(FS)=""
if $EXTRACT(BUF,1,3)="MSH"
SET FS=$EXTRACT(BUF,4)
if $GET(FS)=""
QUIT
+8 ;--- Get the patient IEN
+9 IF $PIECE(BUF,FS)="PID"
if '$EXTRACT(DONE,1)
Begin DoDot:2
+10 ; PID-3
SET PATIEN=+$PIECE(BUF,FS,4)
+11 if PATIEN>0
SET $EXTRACT(DONE,1)="1"
End DoDot:2
QUIT
+12 ;--- Get the specimen date
+13 IF $PIECE(BUF,FS)="OBR"
if '$EXTRACT(DONE,2)
Begin DoDot:2
+14 ; OBR-7
SET DATE=$$HL7TFM^XLFDT($PIECE(BUF,FS,8))
+15 SET $EXTRACT(DONE,2)="1"
End DoDot:2
QUIT
End DoDot:1
if DONE="11"
QUIT
+16 ;--- Create the event reference
+17 if DONE="11"
SET I=$$ADD^RORUPP02(PATIEN,1,DATE)
+18 QUIT
+19 ;
+20 ;***** RETURNS THE LIST OF PACKAGE EVENT PROTOCOLS
+21 ;
+22 ; .EPLST Reference to a local variable. The list of
+23 ; package event protocols will be returned via
+24 ; this parameter: EPLST(ProtocolName)=""
+25 ;
LIST(EPLST) ;
+1 KILL EPLST
+2 SET EPLST("ROR EVENT LAB")=""
+3 SET EPLST("ROR EVENT PTF")=""
+4 SET EPLST("ROR EVENT VISIT")=""
+5 QUIT
+6 ;
+7 ;***** 'ROR EVENT PTF' PROTOCOL IMPLEMENTATION (DATA AREA #3)
PTF ;
+1 NEW ADATE,IEN405,PATIEN,PDATE,RC,TRC
+2 SET PATIEN=$PIECE($GET(DGPMA),"^",3)
if PATIEN'>0
QUIT
+3 ;--- Admissions, transfers and discharges
+4 FOR TRC=1,2,3
Begin DoDot:1
+5 SET IEN405=0
+6 FOR
SET IEN405=$ORDER(^UTILITY("DGPM",$JOB,TRC,IEN405))
if IEN405'>0
QUIT
Begin DoDot:2
+7 SET PDATE=$PIECE($GET(^UTILITY("DGPM",$JOB,TRC,IEN405,"P")),"^")
+8 SET ADATE=$PIECE($GET(^UTILITY("DGPM",$JOB,TRC,IEN405,"A")),"^")
+9 IF PDATE>0
SET RC=$$ADD^RORUPP02(PATIEN,3,PDATE)
+10 IF ADATE>0
if ADATE'=PDATE
SET RC=$$ADD^RORUPP02(PATIEN,3,ADATE)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
+13 ;***** 'ROR EVENT VISIT' PROTOCOL IMPLEMENTATION (DATA AREA #2)
VISIT ;
+1 NEW BUF,IEN,PATIEN,RC,VSIEN
+2 SET VSIEN=""
+3 FOR
SET VSIEN=$ORDER(^TMP("PXKCO",$JOB,VSIEN))
if VSIEN=""
QUIT
Begin DoDot:1
+4 SET IEN=""
+5 FOR
SET IEN=$ORDER(^TMP("PXKCO",$JOB,VSIEN,"VST",IEN))
if IEN=""
QUIT
Begin DoDot:2
+6 SET BUF=$GET(^TMP("PXKCO",$JOB,VSIEN,"VST",IEN,0,"AFTER"))
+7 SET PATIEN=$PIECE(BUF,"^",5)
if (PATIEN'>0)!$PIECE(BUF,"^",11)
QUIT
+8 ;--- Create the event reference
+9 SET RC=$$ADD^RORUPP02(PATIEN,2,$PIECE(BUF,"^",2))
End DoDot:2
End DoDot:1
+10 QUIT
