ROREXT02 ;HCIOFO/SG - DEFAULT MESSAGE BUILDER ;12/7/05 10:44am
;;1.5;CLINICAL CASE REGISTRIES;**10,13,14**;Feb 17, 2006;Build 24
;
; This routine uses the following IAs:
;
; #2056 $$GET1^DIQ (supported)
Q
;
;***** CHECKS IF DEMOGRAPHIC DATA HAS BEEN UPDATED
;
; .RGIENLST Reference to a local array containing registry
; IENs as subscripts and IENs of the corresponding
; patient's registry records as values.
;
; Return Values:
; <0 Error Code
; 0 Demographic data is unchanged
; >0 Demographic data has been updated
;
DEMCHK(RGIENLST) ;
N DEM,IENS,RC,REGIEN,RORMSG
S (DEM,RC,REGIEN)=0
F S REGIEN=$O(RGIENLST(REGIEN)) Q:REGIEN'>0 D Q:DEM!(RC<0)
. S IENS=+RGIENLST(REGIEN)_"," Q:IENS'>0
. S DEM=+$$GET1^DIQ(798,IENS,4,"I",,"RORMSG")
. S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798,IENS)
Q $S(RC<0:RC,1:DEM)
;
;***** EXTRACTS AND PREPARES LABORATORY DATA
;
; PTIEN Patient IEN
;
; .DXDTS Reference to a local variable where the
; data extraction time frames are stored.
;
; [HDTMODE] If this parameter is defined and non-zero, start and
; end dates are specimen collection dates (historical
; extraction). Otherwise, they are dates of the results
; (nightly extraction).
;
; The function uses node ^TMP("RORTMP",$J) as a temporary storage.
;
; Return Values:
; <0 Error Code
; 0 Ok
;
LABDATA(PTIEN,DXDTS,HDTMODE) ;
N ENDT,IDX,RC,RORTMP,STDT,TMP
S RORTMP=$$ALLOC^RORTMP()
S (IDX,RC)=0
F S IDX=$O(DXDTS(1,IDX)) Q:IDX'>0 D Q:RC<0
. S STDT=$P(DXDTS(1,IDX),U),ENDT=$P(DXDTS(1,IDX),U,2)
. ;--- Get the Lab results
. K @RORTMP S TMP=$S($G(HDTMODE):"^CD",1:"^RAD")
. S RC=$$LABRSLTS^RORUTL02(PTIEN,STDT_TMP,ENDT_TMP,RORTMP)
. Q:RC<0
. ;--- Call the Lab data post-processor
. S RC=$$LABPROC(RORTMP,PTIEN)
. ;---
D FREE^RORTMP(RORTMP)
Q $S(RC<0:RC,1:0)
;
;***** LABORATORY DATA POST-PROCESSOR
;
; ROR8TMP Closed root of the array (local or global), which
; contains the data loaded by the $$GCPR^LA7QRY
;
; PTIEN Patient IEN
;
; Return Values:
; <0 Error Code
; 0 Ok
;
LABPROC(ROR8TMP,PTIEN) ;
N BUF,CS,DFLTSITE,FS,I,J,LABC,SEG,TMP
;--- Extract separators from the MSH segment
S BUF=$G(@ROR8TMP@(1))
S:$E(BUF,1,3)="MSH" CS=$E(BUF,5)
S:$G(CS)="" CS="^"
;--- Initialize constants and variables
S LABC="LABC"_CS_"Lab Comment"_CS_"VA080"
;--- Get the default station number and name
S DFLTSITE=$$SITE^RORUTL03(CS)
;
;--- Add the results to the message
S I=0
F S I=$O(@ROR8TMP@(I)) Q:I="" D
. ;--- Load the full segment
. D LOADSEG^RORHL7A(.SEG,$NA(@ROR8TMP@(I))) Q:$G(SEG(0))=""
. D
. . ;--- Use the default station if the local one is missing
. . I SEG(0)="OBX" D Q
. . . S:$P($G(SEG(15)),CS)="" SEG(15)=DFLTSITE
. . ;--- Leave only the code of the Provider
. . I SEG(0)="OBR" D Q
. . . S SEG(16)=+$G(SEG(16)),SEG(24)="LAB"
. . ;--- Replace NTE's with OBX's
. . I SEG(0)="NTE" D Q
. . . K TMP M TMP=SEG(3) K SEG
. . . S SEG(0)="OBX"
. . . S SEG(2)="ST",SEG(3)=LABC,SEG(4)="LCOMM"
. . . M SEG(5)=TMP
. . . S SEG(11)="F"
. . ;--- Skip all other segments
. . K SEG
. ;--- Store the segment
. D:$D(SEG)>1 ADDSEG^RORHL7(.SEG)
. ;check for Lab HCV LOINC during nightly extract
. I $G(SEG(0))="OBX",'$G(HDTMODE) D HCV(.SEG,$G(PTIEN),$G(CS))
Q 0
;
;***** EXTRACTS PATIENT'S DATA AND CREATES THE MESSAGE BODY
;
; PTIEN Patient IEN
;
; .RGIENLST Reference to a local array containing registry
; IENs as subscripts and IENs of the corresponding
; patient's registry records as values.
;
; .DXDTS Either a single time frame in StartDate^EndDate
; format or a reference to a local variable containing
; the list of data extraction time frames. The main
; time frame should be stored in the root node:
;
; DXDTS( MainStartDate^MainEndDate (FileMan)
; DataArea,
; i) StartDate^EndDate (FileMan)
;
; See the $$DXPERIOD^ROREXTUT function for details.
;
; [HDTMODE] This parameter is defined and non-zero during the
; historical data extraction.
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Nothing to send
;
MESSAGE(PTIEN,RGIENLST,DXDTS,HDTMODE) ;
N RORDEM ; Update demographics
;
N CLINPTR,CSRPTR,DEMPTR,PV1PTR,RC,REGIEN,RORMSG,RORPTR,TMP
S HDTMODE=+$G(HDTMODE)
;--- If only the main time frame is provided then
;--- generate the data-specific ones automatically
I $D(DXDTS)<10 D D DXMERGE^ROREXTUT(.DXDTS)
. D DXADD^ROREXTUT(.DXDTS,$P(DXDTS,U),$P(DXDTS,U,2),0,1)
;--- Initialize variables
S RC=$$INIT^RORHL7() Q:RC<0 RC
S RORDEM=$$DEMCHK(.RGIENLST)
;
;=== Demographic data segments
S DEMPTR=$$PTR^RORHL7
S RC=$$PID^RORHL01(PTIEN) Q:RC<0 RC
;--- Period of Service
S RC=$$ZSP^RORHL01(PTIEN) Q:RC<0 RC
;--- Rated Disabilities
S RC=$$ZRD^RORHL01(PTIEN) Q:RC<0 RC
;
;=== Inpatient and Outpatient Encounter Data
S PV1PTR=$$PTR^RORHL7
;--- Inpatient
S RC=$$EN1^RORHL08(PTIEN,.DXDTS,"PV1") Q:RC<0 RC
;--- Outpatient
S RC=$$EN1^RORHL09(PTIEN,.DXDTS,"PV1") Q:RC<0 RC
;
;=== Required CSR segment (dummy)
S CSRPTR=$$PTR^RORHL7
S RC=$$CSR^RORHL02(,PTIEN) Q:RC<0 RC
;
;=== Add other encounter data segments
S CLINPTR=$$PTR^RORHL7
;---Inpatient
S RC=$$EN1^RORHL08(PTIEN,.DXDTS,"OBR") Q:RC<0 RC
;--- Outpatient
S RC=$$EN1^RORHL09(PTIEN,.DXDTS,"OBR") Q:RC<0 RC
;--- Radiology
S RC=$$EN1^RORHL04(PTIEN,.DXDTS) Q:RC<0 RC
;--- Autopsy
S RC=$$EN1^RORHL05(PTIEN,.DXDTS) Q:RC<0 RC
;--- Surgical Pathology
S RC=$$EN1^RORHL10(PTIEN,.DXDTS,HDTMODE) Q:RC<0 RC
;--- Cytopathology
S RC=$$EN1^RORHL11(PTIEN,.DXDTS,HDTMODE) Q:RC<0 RC
;--- Microbiology
S RC=$$EN1^RORHL12(PTIEN,.DXDTS,HDTMODE) Q:RC<0 RC
;--- EKG (Medical Procedures)
S RC=$$EN1^RORHL13(PTIEN,.DXDTS) Q:RC<0 RC
;--- Allergy
S RC=$$EN1^RORHL14(PTIEN,.DXDTS) Q:RC<0 RC
;--- IV
S RC=$$EN1^RORHL15(PTIEN,.DXDTS) Q:RC<0 RC
;--- Vitals
S RC=$$EN1^RORHL16(PTIEN,.DXDTS) Q:RC<0 RC
;--- Problem List
S RC=$$EN1^RORHL17(PTIEN,.DXDTS) Q:RC<0 RC
;--- Lab data
S RC=$$LABDATA(PTIEN,.DXDTS,HDTMODE) Q:RC<0 RC
;--- Pharmacy
S RC=$$EN1^RORHL03(PTIEN,.DXDTS) Q:RC<0 RC
;--- Immunization
S RC=$$EN1^RORHL18(PTIEN,.DXDTS) Q:RC<0 RC
;--- Skin Test Results
S RC=$$EN1^RORHL19(PTIEN,.DXDTS) Q:RC<0 RC
;--- Non-VA Meds
S RC=$$EN1^RORHL20(PTIEN,.DXDTS) Q:RC<0 RC
;--- Purchased Care
S RC=$$EN1^RORHL21(PTIEN,.DXDTS) Q:RC<0 RC
;
;=== Analyze the structure of the message
S RORPTR=$$PTR^RORHL7
;--- If the demographic data has not changed since the previous
; data extraction and no clinical data has been added to the
;--- message, then remove the demographic section completely.
I 'RORDEM,RORPTR'>CLINPTR,CSRPTR'>PV1PTR D
. D ROLLBACK^RORHL7(DEMPTR,1) S CLINPTR=0
;
;=== Registry Data
N IEN
S REGIEN=0
F S REGIEN=$O(RGIENLST(REGIEN)),RC=0 Q:REGIEN'>0 D Q:RC<0
. S IEN=+RGIENLST(REGIEN) Q:IEN'>0
. ;--- If no clinical or demographics data is sent and the local
. ; registry data has not been modified since the last data
. ;--- extraction, then do not include the registry data section.
. I 'CLINPTR D Q:RC
. . S RC='$$GET1^DIQ(798,IEN_",",5,"I",,"RORMSG")
. . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IEN_",")
. ;---
. I $G(ROREXT("MSGBLD",REGIEN))'="" D
. . X "S RC="_ROREXT("MSGBLD",REGIEN)_"(IEN,PTIEN,.DXDTS)"
. E S RC=$$REGDATA(IEN,PTIEN,.DXDTS)
;
;=== Analyze the structure of the message
S RORPTR=$$PTR^RORHL7
Q (RORPTR'>DEMPTR)
;
;***** EXTRACTS REGISTRY-SPECIFIC DATA
;
; RORIEN IEN of the patient record in the registry
;
; PTIEN Patient IEN
;
; .DXDTS Data extraction time frames
;
; [HDTMODE] This parameter is defined and non-zero during the
; historical data extraction.
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Nothing to send
;
REGDATA(RORIEN,PTIEN,DXDTS,HDTMODE) ;
N IENS,RC
S IENS=RORIEN_","
S RC=$$PID^RORHL01(PTIEN) Q:RC<0 RC
S RC=$$CSR^RORHL02(IENS,PTIEN) Q:RC<0 RC
S RC=$$CSP^RORHL02(IENS,DXDTS) Q:RC<0 RC
Q 0
;
;***** CHANGE STATUS FROM PENDING TO CONFIRMED IF POSITIVE LAB HCV TEST RESULT
;Pending patients in the HEPC registry will be confirmed during the nightly
;extract job if they have a positive HCV test result during the extract date range
;
;Input
; SEG Array with Lab HL7 segment "OBX"
; DFN Patient DFN
; CS HL7 Component separator
;
HCV(SEG,DFN,CS) ;
Q:'DFN
I $G(CS)="" S CS="^"
N SEG3 S SEG3=$P($G(SEG(3)),CS,1) I $G(SEG3)="" Q ;Lab LOINC
N SEG5 S SEG5=$G(SEG(5)) I $G(SEG5)="" Q ;test result value
S SEG5=$TR($G(SEG(5)),"""","") ;get rid of any double quotes around test result
I $E($G(SEG5),1,1)=">" D ;if positive test result
. N HEPCIEN S HEPCIEN=$O(^ROR(798.1,"B","VA HEPC",0)) Q:'HEPCIEN ;HEPC registry IEN
. N IEN S IEN=$O(^RORDATA(798,"KEY",DFN,HEPCIEN,0)) Q:(IEN'>0) ;patient IEN in HEPC registry
. D HCVLOAD^RORUPD01 ;load temp ROR HCV LIST array with HVC LOINCs
. I $D(^TMP("ROR HCV LIST",$J,SEG3))>0 D ;patient has HCV LOINC
.. ;if status is pending, change to confirmed
.. I $P($G(^RORDATA(798,IEN,0)),U,5)=4 D
... N RORFDA,IENS,RORMSG
... S IENS=IEN_","
... S RORFDA(798,IENS,3)=0 ;status=confirmed
... S RORFDA(798,IENS,12)="" ;remove pending comment
... D FILE^DIE(,"RORFDA","RORMSG")
K ^TMP("ROR HCV LIST")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HROREXT02 9975 printed Sep 23, 2025@19:17:29 Page 2
ROREXT02 ;HCIOFO/SG - DEFAULT MESSAGE BUILDER ;12/7/05 10:44am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**10,13,14**;Feb 17, 2006;Build 24
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #2056 $$GET1^DIQ (supported)
+6 QUIT
+7 ;
+8 ;***** CHECKS IF DEMOGRAPHIC DATA HAS BEEN UPDATED
+9 ;
+10 ; .RGIENLST Reference to a local array containing registry
+11 ; IENs as subscripts and IENs of the corresponding
+12 ; patient's registry records as values.
+13 ;
+14 ; Return Values:
+15 ; <0 Error Code
+16 ; 0 Demographic data is unchanged
+17 ; >0 Demographic data has been updated
+18 ;
DEMCHK(RGIENLST) ;
+1 NEW DEM,IENS,RC,REGIEN,RORMSG
+2 SET (DEM,RC,REGIEN)=0
+3 FOR
SET REGIEN=$ORDER(RGIENLST(REGIEN))
if REGIEN'>0
QUIT
Begin DoDot:1
+4 SET IENS=+RGIENLST(REGIEN)_","
if IENS'>0
QUIT
+5 SET DEM=+$$GET1^DIQ(798,IENS,4,"I",,"RORMSG")
+6 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,798,IENS)
End DoDot:1
if DEM!(RC<0)
QUIT
+7 QUIT $SELECT(RC<0:RC,1:DEM)
+8 ;
+9 ;***** EXTRACTS AND PREPARES LABORATORY DATA
+10 ;
+11 ; PTIEN Patient IEN
+12 ;
+13 ; .DXDTS Reference to a local variable where the
+14 ; data extraction time frames are stored.
+15 ;
+16 ; [HDTMODE] If this parameter is defined and non-zero, start and
+17 ; end dates are specimen collection dates (historical
+18 ; extraction). Otherwise, they are dates of the results
+19 ; (nightly extraction).
+20 ;
+21 ; The function uses node ^TMP("RORTMP",$J) as a temporary storage.
+22 ;
+23 ; Return Values:
+24 ; <0 Error Code
+25 ; 0 Ok
+26 ;
LABDATA(PTIEN,DXDTS,HDTMODE) ;
+1 NEW ENDT,IDX,RC,RORTMP,STDT,TMP
+2 SET RORTMP=$$ALLOC^RORTMP()
+3 SET (IDX,RC)=0
+4 FOR
SET IDX=$ORDER(DXDTS(1,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+5 SET STDT=$PIECE(DXDTS(1,IDX),U)
SET ENDT=$PIECE(DXDTS(1,IDX),U,2)
+6 ;--- Get the Lab results
+7 KILL @RORTMP
SET TMP=$SELECT($GET(HDTMODE):"^CD",1:"^RAD")
+8 SET RC=$$LABRSLTS^RORUTL02(PTIEN,STDT_TMP,ENDT_TMP,RORTMP)
+9 if RC<0
QUIT
+10 ;--- Call the Lab data post-processor
+11 SET RC=$$LABPROC(RORTMP,PTIEN)
+12 ;---
End DoDot:1
if RC<0
QUIT
+13 DO FREE^RORTMP(RORTMP)
+14 QUIT $SELECT(RC<0:RC,1:0)
+15 ;
+16 ;***** LABORATORY DATA POST-PROCESSOR
+17 ;
+18 ; ROR8TMP Closed root of the array (local or global), which
+19 ; contains the data loaded by the $$GCPR^LA7QRY
+20 ;
+21 ; PTIEN Patient IEN
+22 ;
+23 ; Return Values:
+24 ; <0 Error Code
+25 ; 0 Ok
+26 ;
LABPROC(ROR8TMP,PTIEN) ;
+1 NEW BUF,CS,DFLTSITE,FS,I,J,LABC,SEG,TMP
+2 ;--- Extract separators from the MSH segment
+3 SET BUF=$GET(@ROR8TMP@(1))
+4 if $EXTRACT(BUF,1,3)="MSH"
SET CS=$EXTRACT(BUF,5)
+5 if $GET(CS)=""
SET CS="^"
+6 ;--- Initialize constants and variables
+7 SET LABC="LABC"_CS_"Lab Comment"_CS_"VA080"
+8 ;--- Get the default station number and name
+9 SET DFLTSITE=$$SITE^RORUTL03(CS)
+10 ;
+11 ;--- Add the results to the message
+12 SET I=0
+13 FOR
SET I=$ORDER(@ROR8TMP@(I))
if I=""
QUIT
Begin DoDot:1
+14 ;--- Load the full segment
+15 DO LOADSEG^RORHL7A(.SEG,$NAME(@ROR8TMP@(I)))
if $GET(SEG(0))=""
QUIT
+16 Begin DoDot:2
+17 ;--- Use the default station if the local one is missing
+18 IF SEG(0)="OBX"
Begin DoDot:3
+19 if $PIECE($GET(SEG(15)),CS)=""
SET SEG(15)=DFLTSITE
End DoDot:3
QUIT
+20 ;--- Leave only the code of the Provider
+21 IF SEG(0)="OBR"
Begin DoDot:3
+22 SET SEG(16)=+$GET(SEG(16))
SET SEG(24)="LAB"
End DoDot:3
QUIT
+23 ;--- Replace NTE's with OBX's
+24 IF SEG(0)="NTE"
Begin DoDot:3
+25 KILL TMP
MERGE TMP=SEG(3)
KILL SEG
+26 SET SEG(0)="OBX"
+27 SET SEG(2)="ST"
SET SEG(3)=LABC
SET SEG(4)="LCOMM"
+28 MERGE SEG(5)=TMP
+29 SET SEG(11)="F"
End DoDot:3
QUIT
+30 ;--- Skip all other segments
+31 KILL SEG
End DoDot:2
+32 ;--- Store the segment
+33 if $DATA(SEG)>1
DO ADDSEG^RORHL7(.SEG)
+34 ;check for Lab HCV LOINC during nightly extract
+35 IF $GET(SEG(0))="OBX"
IF '$GET(HDTMODE)
DO HCV(.SEG,$GET(PTIEN),$GET(CS))
End DoDot:1
+36 QUIT 0
+37 ;
+38 ;***** EXTRACTS PATIENT'S DATA AND CREATES THE MESSAGE BODY
+39 ;
+40 ; PTIEN Patient IEN
+41 ;
+42 ; .RGIENLST Reference to a local array containing registry
+43 ; IENs as subscripts and IENs of the corresponding
+44 ; patient's registry records as values.
+45 ;
+46 ; .DXDTS Either a single time frame in StartDate^EndDate
+47 ; format or a reference to a local variable containing
+48 ; the list of data extraction time frames. The main
+49 ; time frame should be stored in the root node:
+50 ;
+51 ; DXDTS( MainStartDate^MainEndDate (FileMan)
+52 ; DataArea,
+53 ; i) StartDate^EndDate (FileMan)
+54 ;
+55 ; See the $$DXPERIOD^ROREXTUT function for details.
+56 ;
+57 ; [HDTMODE] This parameter is defined and non-zero during the
+58 ; historical data extraction.
+59 ;
+60 ; Return Values:
+61 ; <0 Error Code
+62 ; 0 Ok
+63 ; >0 Nothing to send
+64 ;
MESSAGE(PTIEN,RGIENLST,DXDTS,HDTMODE) ;
+1 ; Update demographics
NEW RORDEM
+2 ;
+3 NEW CLINPTR,CSRPTR,DEMPTR,PV1PTR,RC,REGIEN,RORMSG,RORPTR,TMP
+4 SET HDTMODE=+$GET(HDTMODE)
+5 ;--- If only the main time frame is provided then
+6 ;--- generate the data-specific ones automatically
+7 IF $DATA(DXDTS)<10
Begin DoDot:1
+8 DO DXADD^ROREXTUT(.DXDTS,$PIECE(DXDTS,U),$PIECE(DXDTS,U,2),0,1)
End DoDot:1
DO DXMERGE^ROREXTUT(.DXDTS)
+9 ;--- Initialize variables
+10 SET RC=$$INIT^RORHL7()
if RC<0
QUIT RC
+11 SET RORDEM=$$DEMCHK(.RGIENLST)
+12 ;
+13 ;=== Demographic data segments
+14 SET DEMPTR=$$PTR^RORHL7
+15 SET RC=$$PID^RORHL01(PTIEN)
if RC<0
QUIT RC
+16 ;--- Period of Service
+17 SET RC=$$ZSP^RORHL01(PTIEN)
if RC<0
QUIT RC
+18 ;--- Rated Disabilities
+19 SET RC=$$ZRD^RORHL01(PTIEN)
if RC<0
QUIT RC
+20 ;
+21 ;=== Inpatient and Outpatient Encounter Data
+22 SET PV1PTR=$$PTR^RORHL7
+23 ;--- Inpatient
+24 SET RC=$$EN1^RORHL08(PTIEN,.DXDTS,"PV1")
if RC<0
QUIT RC
+25 ;--- Outpatient
+26 SET RC=$$EN1^RORHL09(PTIEN,.DXDTS,"PV1")
if RC<0
QUIT RC
+27 ;
+28 ;=== Required CSR segment (dummy)
+29 SET CSRPTR=$$PTR^RORHL7
+30 SET RC=$$CSR^RORHL02(,PTIEN)
if RC<0
QUIT RC
+31 ;
+32 ;=== Add other encounter data segments
+33 SET CLINPTR=$$PTR^RORHL7
+34 ;---Inpatient
+35 SET RC=$$EN1^RORHL08(PTIEN,.DXDTS,"OBR")
if RC<0
QUIT RC
+36 ;--- Outpatient
+37 SET RC=$$EN1^RORHL09(PTIEN,.DXDTS,"OBR")
if RC<0
QUIT RC
+38 ;--- Radiology
+39 SET RC=$$EN1^RORHL04(PTIEN,.DXDTS)
if RC<0
QUIT RC
+40 ;--- Autopsy
+41 SET RC=$$EN1^RORHL05(PTIEN,.DXDTS)
if RC<0
QUIT RC
+42 ;--- Surgical Pathology
+43 SET RC=$$EN1^RORHL10(PTIEN,.DXDTS,HDTMODE)
if RC<0
QUIT RC
+44 ;--- Cytopathology
+45 SET RC=$$EN1^RORHL11(PTIEN,.DXDTS,HDTMODE)
if RC<0
QUIT RC
+46 ;--- Microbiology
+47 SET RC=$$EN1^RORHL12(PTIEN,.DXDTS,HDTMODE)
if RC<0
QUIT RC
+48 ;--- EKG (Medical Procedures)
+49 SET RC=$$EN1^RORHL13(PTIEN,.DXDTS)
if RC<0
QUIT RC
+50 ;--- Allergy
+51 SET RC=$$EN1^RORHL14(PTIEN,.DXDTS)
if RC<0
QUIT RC
+52 ;--- IV
+53 SET RC=$$EN1^RORHL15(PTIEN,.DXDTS)
if RC<0
QUIT RC
+54 ;--- Vitals
+55 SET RC=$$EN1^RORHL16(PTIEN,.DXDTS)
if RC<0
QUIT RC
+56 ;--- Problem List
+57 SET RC=$$EN1^RORHL17(PTIEN,.DXDTS)
if RC<0
QUIT RC
+58 ;--- Lab data
+59 SET RC=$$LABDATA(PTIEN,.DXDTS,HDTMODE)
if RC<0
QUIT RC
+60 ;--- Pharmacy
+61 SET RC=$$EN1^RORHL03(PTIEN,.DXDTS)
if RC<0
QUIT RC
+62 ;--- Immunization
+63 SET RC=$$EN1^RORHL18(PTIEN,.DXDTS)
if RC<0
QUIT RC
+64 ;--- Skin Test Results
+65 SET RC=$$EN1^RORHL19(PTIEN,.DXDTS)
if RC<0
QUIT RC
+66 ;--- Non-VA Meds
+67 SET RC=$$EN1^RORHL20(PTIEN,.DXDTS)
if RC<0
QUIT RC
+68 ;--- Purchased Care
+69 SET RC=$$EN1^RORHL21(PTIEN,.DXDTS)
if RC<0
QUIT RC
+70 ;
+71 ;=== Analyze the structure of the message
+72 SET RORPTR=$$PTR^RORHL7
+73 ;--- If the demographic data has not changed since the previous
+74 ; data extraction and no clinical data has been added to the
+75 ;--- message, then remove the demographic section completely.
+76 IF 'RORDEM
IF RORPTR'>CLINPTR
IF CSRPTR'>PV1PTR
Begin DoDot:1
+77 DO ROLLBACK^RORHL7(DEMPTR,1)
SET CLINPTR=0
End DoDot:1
+78 ;
+79 ;=== Registry Data
+80 NEW IEN
+81 SET REGIEN=0
+82 FOR
SET REGIEN=$ORDER(RGIENLST(REGIEN))
SET RC=0
if REGIEN'>0
QUIT
Begin DoDot:1
+83 SET IEN=+RGIENLST(REGIEN)
if IEN'>0
QUIT
+84 ;--- If no clinical or demographics data is sent and the local
+85 ; registry data has not been modified since the last data
+86 ;--- extraction, then do not include the registry data section.
+87 IF 'CLINPTR
Begin DoDot:2
+88 SET RC='$$GET1^DIQ(798,IEN_",",5,"I",,"RORMSG")
+89 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IEN_",")
End DoDot:2
if RC
QUIT
+90 ;---
+91 IF $GET(ROREXT("MSGBLD",REGIEN))'=""
Begin DoDot:2
+92 XECUTE "S RC="_ROREXT("MSGBLD",REGIEN)_"(IEN,PTIEN,.DXDTS)"
End DoDot:2
+93 IF '$TEST
SET RC=$$REGDATA(IEN,PTIEN,.DXDTS)
End DoDot:1
if RC<0
QUIT
+94 ;
+95 ;=== Analyze the structure of the message
+96 SET RORPTR=$$PTR^RORHL7
+97 QUIT (RORPTR'>DEMPTR)
+98 ;
+99 ;***** EXTRACTS REGISTRY-SPECIFIC DATA
+100 ;
+101 ; RORIEN IEN of the patient record in the registry
+102 ;
+103 ; PTIEN Patient IEN
+104 ;
+105 ; .DXDTS Data extraction time frames
+106 ;
+107 ; [HDTMODE] This parameter is defined and non-zero during the
+108 ; historical data extraction.
+109 ;
+110 ; Return Values:
+111 ; <0 Error Code
+112 ; 0 Ok
+113 ; >0 Nothing to send
+114 ;
REGDATA(RORIEN,PTIEN,DXDTS,HDTMODE) ;
+1 NEW IENS,RC
+2 SET IENS=RORIEN_","
+3 SET RC=$$PID^RORHL01(PTIEN)
if RC<0
QUIT RC
+4 SET RC=$$CSR^RORHL02(IENS,PTIEN)
if RC<0
QUIT RC
+5 SET RC=$$CSP^RORHL02(IENS,DXDTS)
if RC<0
QUIT RC
+6 QUIT 0
+7 ;
+8 ;***** CHANGE STATUS FROM PENDING TO CONFIRMED IF POSITIVE LAB HCV TEST RESULT
+9 ;Pending patients in the HEPC registry will be confirmed during the nightly
+10 ;extract job if they have a positive HCV test result during the extract date range
+11 ;
+12 ;Input
+13 ; SEG Array with Lab HL7 segment "OBX"
+14 ; DFN Patient DFN
+15 ; CS HL7 Component separator
+16 ;
HCV(SEG,DFN,CS) ;
+1 if 'DFN
QUIT
+2 IF $GET(CS)=""
SET CS="^"
+3 ;Lab LOINC
NEW SEG3
SET SEG3=$PIECE($GET(SEG(3)),CS,1)
IF $GET(SEG3)=""
QUIT
+4 ;test result value
NEW SEG5
SET SEG5=$GET(SEG(5))
IF $GET(SEG5)=""
QUIT
+5 ;get rid of any double quotes around test result
SET SEG5=$TRANSLATE($GET(SEG(5)),"""","")
+6 ;if positive test result
IF $EXTRACT($GET(SEG5),1,1)=">"
Begin DoDot:1
+7 ;HEPC registry IEN
NEW HEPCIEN
SET HEPCIEN=$ORDER(^ROR(798.1,"B","VA HEPC",0))
if 'HEPCIEN
QUIT
+8 ;patient IEN in HEPC registry
NEW IEN
SET IEN=$ORDER(^RORDATA(798,"KEY",DFN,HEPCIEN,0))
if (IEN'>0)
QUIT
+9 ;load temp ROR HCV LIST array with HVC LOINCs
DO HCVLOAD^RORUPD01
+10 ;patient has HCV LOINC
IF $DATA(^TMP("ROR HCV LIST",$JOB,SEG3))>0
Begin DoDot:2
+11 ;if status is pending, change to confirmed
+12 IF $PIECE($GET(^RORDATA(798,IEN,0)),U,5)=4
Begin DoDot:3
+13 NEW RORFDA,IENS,RORMSG
+14 SET IENS=IEN_","
+15 ;status=confirmed
SET RORFDA(798,IENS,3)=0
+16 ;remove pending comment
SET RORFDA(798,IENS,12)=""
+17 DO FILE^DIE(,"RORFDA","RORMSG")
End DoDot:3
End DoDot:2
End DoDot:1
+18 KILL ^TMP("ROR HCV LIST")
+19 QUIT
