- 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 Feb 18, 2025@23:07:49 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