- 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 Jan 18, 2025@02:42:58 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)