RORHL02 ;HOIFO/CRT,SG - HL7 REGISTRY DATA: CSP,CSR,CSS ;12/6/05 2:36pm
;;1.5;CLINICAL CASE REGISTRIES;**14**;Feb 17, 2006;Build 24
;
Q
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*14 APR 2011 A SAUNDERS CSR: Added HIV DX - FIRST DIAGNOSED
; (#12.08) to CSR-12. Date of Clnincal
; AIDS logic modified for 'unknown'.
;******************************************************************************
;******************************************************************************
;
;***** CSP SEGMENTS BUILDER
;
; RORIENS IENS of Patient Record in Registry File
;
; DXDTS Main time frame for data extraction in
; StartDate^EndDate format
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Non-fatal error(s)
;
CSP(RORIENS,DXDTS) ;
N CS,ERRCNT,FLDS,RC,RORMSG,ROROUT,STATUS,TMP
S (ERRCNT,RC)=0
;--- Check the parameters
S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
;
S FLDS="1;2;3;3.2;6"
D GETS^DIQ(798,RORIENS,FLDS,"IE","ROROUT","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,RORIENS)
I $$ICRDEF^RORHIVUT(+RORIENS) D Q:RC<0 RC
. D GETS^DIQ(799.4,RORIENS,"9.01","IE","ROROUT","RORMSG")
. S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,799.4,RORIENS)
;
S STATUS=+$G(ROROUT(798,RORIENS,3,"I"))
;--- UPDATE
I $G(DXDTS)>0 D Q:RC<0 RC
. S RC=$$CSPSEG(0,$P(DXDTS,U),$P(DXDTS,U,2))
;--- SELECT
S RC=$$CSPSEG(1,$G(ROROUT(798,RORIENS,3.2,"I"))) Q:RC<0 RC
;--- ADD
S RC=$$CSPSEG(2,$G(ROROUT(798,RORIENS,1,"I"))) Q:RC<0 RC
;--- CONFIRM
I $G(ROROUT(798,RORIENS,2,"I"))>0 D Q:RC<0 RC
. S RC=$$CSPSEG(3,ROROUT(798,RORIENS,2,"I"))
;--- DELETE
I STATUS=5 D Q:RC<0 RC
. S RC=$$CSPSEG(4,$G(ROROUT(798,RORIENS,6,"I")))
;--- CDC
I $G(ROROUT(799.4,RORIENS,9.01,"I"))>0 D Q:RC<0 RC
. S RC=$$CSPSEG(5,ROROUT(799.4,RORIENS,9.01,"I"))
;---
Q ERRCNT
;
;***** LOW-LEVEL CSP BUILDER
;
; RGEVC Registry event code
; DATE Event date (FileMan)
; [ENDT] End date (FileMan)
;
; Return Values:
; <0 Error Code
; 0 Ok
;
CSPSEG(RGEVC,DATE,ENDT,CSP4) ;
;;UPDATE^SELECT^ADD^CONFIRM^DELETE^CDC^MERGE
N CS,RORSEG,TMP
D ECH^RORHL7(.CS)
;
;--- Initialize the segment
S RORSEG(0)="CSP"
;
;--- CSP-1
S TMP=$S(RGEVC'<0:$P($P($T(CSPSEG+1),";;",2),U,RGEVC+1),1:"")
Q:TMP="" $$ERROR^RORERR(-88,,,,"RGEVC",RGEVC)
S RORSEG(1)=RGEVC_CS_TMP
;
;--- CSP-2
S RORSEG(2)=$$FM2HL^RORHL7(DATE)
;
;--- CSP-3
S:$G(ENDT)>0 RORSEG(3)=$$FM2HL^RORHL7(ENDT)
;
;--- CSP-4
S:$G(CSP4)'?." " RORSEG(4)=CSP4
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q 0
;
;***** CSR SEGMENT BUILDER
;
; [RORIENS] IENS of Patient Record in Registry File. Either this
; parameter or the PTIEN must have a valid value.
;
; [PTIEN] Patient IEN (DFN). If no value is provided for this
; parameter, then the function uses the value of the
; .01 field of the patient's registry record.
;
; [RORFLDS] Segment Fields to populate
; (1,3,4,6,9,10,12 available)
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Non-fatal error(s)
;
CSR(RORIENS,PTIEN,RORFLDS) ;
N BUF,CS,ERRCNT,HIVIENS,RC,RORMSG,ROROUT,RORSEG,RORTXT,RPS,SCS,TMP,VER
S (ERRCNT,RC)=0,HIVIENS=""
D ECH^RORHL7(.CS,.SCS,.RPS)
S PTIEN=+$G(PTIEN)
;
I $G(RORIENS)>0 D Q:RC<0 RC
. S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
. D GETS^DIQ(798,RORIENS,".01;.02;1","IE","ROROUT","RORMSG")
. I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798,RORIENS) Q
. S:PTIEN'>0 PTIEN=+$G(ROROUT(798,RORIENS,.01,"I"))
. S:$D(^RORDATA(799.4,+RORIENS,0)) HIVIENS=RORIENS
E S RORIENS=""
;
I $G(RORFLDS)'="" D
. S:$E(RORFLDS)'="," RORFLDS=","_RORFLDS
. S:$E(RORFLDS,$L(RORFLDS))'="," RORFLDS=RORFLDS_","
E S RORFLDS=",1,3,4,6,9,10,12," ; Default HL7 fields
;
;--- Initialize the segment
S RORSEG(0)="CSR"
;
;--- CSR-1 - Name of the registry and version of the CCR
I RORFLDS[",1," D
. S VER=+$P(ROREXT("VERSION"),U) ; Version
. S:$P(VER,".",2)="" $P(VER,".",2)="0"
. S $P(VER,".",3)=+$P(ROREXT("VERSION"),U,2) ; Patch Number
. S $P(VER,".",4)=+$$BUILD^ROR ; Build Number
. S TMP=$S(RORIENS'="":$G(ROROUT(798,RORIENS,.02,"E")),1:"")
. S RORSEG(1)=$S(TMP'="":TMP,1:"CCR")_CS_VER
;
;--- CSR-3 - Institution
I RORFLDS[",3," D
. S RORSEG(3)=$$SITE^RORUTL03(CS)
;
;--- CSR-4 - Patient ID
I RORFLDS[",4," D
. S RORSEG(4)=PTIEN_CS_CS_CS_"USVHA"_CS_"PI"
;
;--- CSR-6 - Date when added to the registry
I RORFLDS[",6,",RORIENS'="" D Q:RC<0 RC
. S TMP=$$FMTHL7^XLFDT($G(ROROUT(798,RORIENS,1,"I"))\1)
. I TMP'>0 S RC=$$ERROR^RORERR(-95,,,,798,RORIENS,1) Q
. S RORSEG(6)=TMP
;
;--- CSR-9 - Date of Clinical AIDS (HIV)
I RORFLDS[",9,",HIVIENS'="" D Q:RC<0 RC
. D GETS^DIQ(799.4,HIVIENS,".02;.03","I","ROROUT","RORMSG")
. I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
. . D DBS^RORERR("RORMSG",-9,,,799.4,HIVIENS)
. ;if not 'yes', set date to null
. I $G(ROROUT(799.4,HIVIENS,.02,"I"))'=1 S TMP=""
. E S TMP=$G(ROROUT(799.4,HIVIENS,.03,"I"))
. S RORSEG(9)=$$FM2HL^RORHL7(TMP)
;
;--- CSR-10 - Reason for addition of the patient to the registry
I RORFLDS[",10,",RORIENS'="" D Q:RC<0 RC
. S RORSEG(10)=$$ADREASON^RORHLUT1(RORIENS,CS)
;
;--- CSR-12 - Risk factors
I RORFLDS[",12,",HIVIENS'="" D Q:RC<0 RC
. N CNT,EV,FLD,RFLST,RORBUF,RORQUIT,RORRISK
. ;S RFLST="14.01;14.02;14.03;14.04;14.07;14.08;14.09;14.1;14.11;14.12;14.13;14.16;14.17"
. S RFLST="14.01;14.02;14.03;14.04;14.07;14.08;14.09;14.1;14.11;14.12;14.13;14.16;14.17;12.08"
. D GETS^DIQ(799.4,HIVIENS,RFLST,"I","RORBUF","RORMSG")
. I $G(DIERR) D S ERRCNT=ERRCNT+1
. . D DBS^RORERR("RORMSG",-9,,,799.4,HIVIENS)
. ;---
. S RORRISK="",RORQUIT=0
. F CNT=1:1 S FLD=$P(RFLST,";",CNT) Q:FLD="" D:FLD>0 Q:RORQUIT
. . S TMP=$G(RORBUF(799.4,HIVIENS,FLD,"I"))
. . S EV=$S(TMP=0:"NO",TMP=1:"YES",TMP=9:"UNKNOWN",1:"")
. . ;I EV="" S RORRISK="",RORQUIT=1 Q ;risk factors can be null
. . I $G(EV)="" S TMP=""
. . S $P(RORRISK,RPS,CNT)=$G(TMP)_CS_$G(EV)
. S RORSEG(12)=RORRISK
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q $S(RC<0:RC,1:ERRCNT)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL02 6745 printed Dec 13, 2024@01:41:44 Page 2
RORHL02 ;HOIFO/CRT,SG - HL7 REGISTRY DATA: CSP,CSR,CSS ;12/6/05 2:36pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**14**;Feb 17, 2006;Build 24
+2 ;
+3 QUIT
+4 ;******************************************************************************
+5 ;******************************************************************************
+6 ; --- ROUTINE MODIFICATION LOG ---
+7 ;
+8 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+9 ;----------- ---------- ----------- ----------------------------------------
+10 ;ROR*1.5*14 APR 2011 A SAUNDERS CSR: Added HIV DX - FIRST DIAGNOSED
+11 ; (#12.08) to CSR-12. Date of Clnincal
+12 ; AIDS logic modified for 'unknown'.
+13 ;******************************************************************************
+14 ;******************************************************************************
+15 ;
+16 ;***** CSP SEGMENTS BUILDER
+17 ;
+18 ; RORIENS IENS of Patient Record in Registry File
+19 ;
+20 ; DXDTS Main time frame for data extraction in
+21 ; StartDate^EndDate format
+22 ;
+23 ; Return Values:
+24 ; <0 Error Code
+25 ; 0 Ok
+26 ; >0 Non-fatal error(s)
+27 ;
CSP(RORIENS,DXDTS) ;
+1 NEW CS,ERRCNT,FLDS,RC,RORMSG,ROROUT,STATUS,TMP
+2 SET (ERRCNT,RC)=0
+3 ;--- Check the parameters
+4 if $EXTRACT(RORIENS,$LENGTH(RORIENS))'=","
SET RORIENS=RORIENS_","
+5 ;
+6 SET FLDS="1;2;3;3.2;6"
+7 DO GETS^DIQ(798,RORIENS,FLDS,"IE","ROROUT","RORMSG")
+8 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,798,RORIENS)
+9 IF $$ICRDEF^RORHIVUT(+RORIENS)
Begin DoDot:1
+10 DO GETS^DIQ(799.4,RORIENS,"9.01","IE","ROROUT","RORMSG")
+11 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,799.4,RORIENS)
End DoDot:1
if RC<0
QUIT RC
+12 ;
+13 SET STATUS=+$GET(ROROUT(798,RORIENS,3,"I"))
+14 ;--- UPDATE
+15 IF $GET(DXDTS)>0
Begin DoDot:1
+16 SET RC=$$CSPSEG(0,$PIECE(DXDTS,U),$PIECE(DXDTS,U,2))
End DoDot:1
if RC<0
QUIT RC
+17 ;--- SELECT
+18 SET RC=$$CSPSEG(1,$GET(ROROUT(798,RORIENS,3.2,"I")))
if RC<0
QUIT RC
+19 ;--- ADD
+20 SET RC=$$CSPSEG(2,$GET(ROROUT(798,RORIENS,1,"I")))
if RC<0
QUIT RC
+21 ;--- CONFIRM
+22 IF $GET(ROROUT(798,RORIENS,2,"I"))>0
Begin DoDot:1
+23 SET RC=$$CSPSEG(3,ROROUT(798,RORIENS,2,"I"))
End DoDot:1
if RC<0
QUIT RC
+24 ;--- DELETE
+25 IF STATUS=5
Begin DoDot:1
+26 SET RC=$$CSPSEG(4,$GET(ROROUT(798,RORIENS,6,"I")))
End DoDot:1
if RC<0
QUIT RC
+27 ;--- CDC
+28 IF $GET(ROROUT(799.4,RORIENS,9.01,"I"))>0
Begin DoDot:1
+29 SET RC=$$CSPSEG(5,ROROUT(799.4,RORIENS,9.01,"I"))
End DoDot:1
if RC<0
QUIT RC
+30 ;---
+31 QUIT ERRCNT
+32 ;
+33 ;***** LOW-LEVEL CSP BUILDER
+34 ;
+35 ; RGEVC Registry event code
+36 ; DATE Event date (FileMan)
+37 ; [ENDT] End date (FileMan)
+38 ;
+39 ; Return Values:
+40 ; <0 Error Code
+41 ; 0 Ok
+42 ;
CSPSEG(RGEVC,DATE,ENDT,CSP4) ;
+1 ;;UPDATE^SELECT^ADD^CONFIRM^DELETE^CDC^MERGE
+2 NEW CS,RORSEG,TMP
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;--- Initialize the segment
+6 SET RORSEG(0)="CSP"
+7 ;
+8 ;--- CSP-1
+9 SET TMP=$SELECT(RGEVC'<0:$PIECE($PIECE($TEXT(CSPSEG+1),";;",2),U,RGEVC+1),1:"")
+10 if TMP=""
QUIT $$ERROR^RORERR(-88,,,,"RGEVC",RGEVC)
+11 SET RORSEG(1)=RGEVC_CS_TMP
+12 ;
+13 ;--- CSP-2
+14 SET RORSEG(2)=$$FM2HL^RORHL7(DATE)
+15 ;
+16 ;--- CSP-3
+17 if $GET(ENDT)>0
SET RORSEG(3)=$$FM2HL^RORHL7(ENDT)
+18 ;
+19 ;--- CSP-4
+20 if $GET(CSP4)'?." "
SET RORSEG(4)=CSP4
+21 ;
+22 ;--- Store the segment
+23 DO ADDSEG^RORHL7(.RORSEG)
+24 QUIT 0
+25 ;
+26 ;***** CSR SEGMENT BUILDER
+27 ;
+28 ; [RORIENS] IENS of Patient Record in Registry File. Either this
+29 ; parameter or the PTIEN must have a valid value.
+30 ;
+31 ; [PTIEN] Patient IEN (DFN). If no value is provided for this
+32 ; parameter, then the function uses the value of the
+33 ; .01 field of the patient's registry record.
+34 ;
+35 ; [RORFLDS] Segment Fields to populate
+36 ; (1,3,4,6,9,10,12 available)
+37 ;
+38 ; Return Values:
+39 ; <0 Error Code
+40 ; 0 Ok
+41 ; >0 Non-fatal error(s)
+42 ;
CSR(RORIENS,PTIEN,RORFLDS) ;
+1 NEW BUF,CS,ERRCNT,HIVIENS,RC,RORMSG,ROROUT,RORSEG,RORTXT,RPS,SCS,TMP,VER
+2 SET (ERRCNT,RC)=0
SET HIVIENS=""
+3 DO ECH^RORHL7(.CS,.SCS,.RPS)
+4 SET PTIEN=+$GET(PTIEN)
+5 ;
+6 IF $GET(RORIENS)>0
Begin DoDot:1
+7 if $EXTRACT(RORIENS,$LENGTH(RORIENS))'=","
SET RORIENS=RORIENS_","
+8 DO GETS^DIQ(798,RORIENS,".01;.02;1","IE","ROROUT","RORMSG")
+9 IF $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,798,RORIENS)
QUIT
+10 if PTIEN'>0
SET PTIEN=+$GET(ROROUT(798,RORIENS,.01,"I"))
+11 if $DATA(^RORDATA(799.4,+RORIENS,0))
SET HIVIENS=RORIENS
End DoDot:1
if RC<0
QUIT RC
+12 IF '$TEST
SET RORIENS=""
+13 ;
+14 IF $GET(RORFLDS)'=""
Begin DoDot:1
+15 if $EXTRACT(RORFLDS)'=","
SET RORFLDS=","_RORFLDS
+16 if $EXTRACT(RORFLDS,$LENGTH(RORFLDS))'=","
SET RORFLDS=RORFLDS_","
End DoDot:1
+17 ; Default HL7 fields
IF '$TEST
SET RORFLDS=",1,3,4,6,9,10,12,"
+18 ;
+19 ;--- Initialize the segment
+20 SET RORSEG(0)="CSR"
+21 ;
+22 ;--- CSR-1 - Name of the registry and version of the CCR
+23 IF RORFLDS[",1,"
Begin DoDot:1
+24 ; Version
SET VER=+$PIECE(ROREXT("VERSION"),U)
+25 if $PIECE(VER,".",2)=""
SET $PIECE(VER,".",2)="0"
+26 ; Patch Number
SET $PIECE(VER,".",3)=+$PIECE(ROREXT("VERSION"),U,2)
+27 ; Build Number
SET $PIECE(VER,".",4)=+$$BUILD^ROR
+28 SET TMP=$SELECT(RORIENS'="":$GET(ROROUT(798,RORIENS,.02,"E")),1:"")
+29 SET RORSEG(1)=$SELECT(TMP'="":TMP,1:"CCR")_CS_VER
End DoDot:1
+30 ;
+31 ;--- CSR-3 - Institution
+32 IF RORFLDS[",3,"
Begin DoDot:1
+33 SET RORSEG(3)=$$SITE^RORUTL03(CS)
End DoDot:1
+34 ;
+35 ;--- CSR-4 - Patient ID
+36 IF RORFLDS[",4,"
Begin DoDot:1
+37 SET RORSEG(4)=PTIEN_CS_CS_CS_"USVHA"_CS_"PI"
End DoDot:1
+38 ;
+39 ;--- CSR-6 - Date when added to the registry
+40 IF RORFLDS[",6,"
IF RORIENS'=""
Begin DoDot:1
+41 SET TMP=$$FMTHL7^XLFDT($GET(ROROUT(798,RORIENS,1,"I"))\1)
+42 IF TMP'>0
SET RC=$$ERROR^RORERR(-95,,,,798,RORIENS,1)
QUIT
+43 SET RORSEG(6)=TMP
End DoDot:1
if RC<0
QUIT RC
+44 ;
+45 ;--- CSR-9 - Date of Clinical AIDS (HIV)
+46 IF RORFLDS[",9,"
IF HIVIENS'=""
Begin DoDot:1
+47 DO GETS^DIQ(799.4,HIVIENS,".02;.03","I","ROROUT","RORMSG")
+48 IF $GET(DIERR)
Begin DoDot:2
+49 DO DBS^RORERR("RORMSG",-9,,,799.4,HIVIENS)
End DoDot:2
SET ERRCNT=ERRCNT+1
QUIT
+50 ;if not 'yes', set date to null
+51 IF $GET(ROROUT(799.4,HIVIENS,.02,"I"))'=1
SET TMP=""
+52 IF '$TEST
SET TMP=$GET(ROROUT(799.4,HIVIENS,.03,"I"))
+53 SET RORSEG(9)=$$FM2HL^RORHL7(TMP)
End DoDot:1
if RC<0
QUIT RC
+54 ;
+55 ;--- CSR-10 - Reason for addition of the patient to the registry
+56 IF RORFLDS[",10,"
IF RORIENS'=""
Begin DoDot:1
+57 SET RORSEG(10)=$$ADREASON^RORHLUT1(RORIENS,CS)
End DoDot:1
if RC<0
QUIT RC
+58 ;
+59 ;--- CSR-12 - Risk factors
+60 IF RORFLDS[",12,"
IF HIVIENS'=""
Begin DoDot:1
+61 NEW CNT,EV,FLD,RFLST,RORBUF,RORQUIT,RORRISK
+62 ;S RFLST="14.01;14.02;14.03;14.04;14.07;14.08;14.09;14.1;14.11;14.12;14.13;14.16;14.17"
+63 SET RFLST="14.01;14.02;14.03;14.04;14.07;14.08;14.09;14.1;14.11;14.12;14.13;14.16;14.17;12.08"
+64 DO GETS^DIQ(799.4,HIVIENS,RFLST,"I","RORBUF","RORMSG")
+65 IF $GET(DIERR)
Begin DoDot:2
+66 DO DBS^RORERR("RORMSG",-9,,,799.4,HIVIENS)
End DoDot:2
SET ERRCNT=ERRCNT+1
+67 ;---
+68 SET RORRISK=""
SET RORQUIT=0
+69 FOR CNT=1:1
SET FLD=$PIECE(RFLST,";",CNT)
if FLD=""
QUIT
if FLD>0
Begin DoDot:2
+70 SET TMP=$GET(RORBUF(799.4,HIVIENS,FLD,"I"))
+71 SET EV=$SELECT(TMP=0:"NO",TMP=1:"YES",TMP=9:"UNKNOWN",1:"")
+72 ;I EV="" S RORRISK="",RORQUIT=1 Q ;risk factors can be null
+73 IF $GET(EV)=""
SET TMP=""
+74 SET $PIECE(RORRISK,RPS,CNT)=$GET(TMP)_CS_$GET(EV)
End DoDot:2
if RORQUIT
QUIT
+75 SET RORSEG(12)=RORRISK
End DoDot:1
if RC<0
QUIT RC
+76 ;
+77 ;--- Store the segment
+78 DO ADDSEG^RORHL7(.RORSEG)
+79 QUIT $SELECT(RC<0:RC,1:ERRCNT)
