Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORHL02

RORHL02.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*14 APR 2011 A SAUNDERS CSR: Added HIV DX - FIRST DIAGNOSED
  1. ; (#12.08) to CSR-12. Date of Clnincal
  1. ; AIDS logic modified for 'unknown'.
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ;
  1. ;***** CSP SEGMENTS BUILDER
  1. ;
  1. ; RORIENS IENS of Patient Record in Registry File
  1. ;
  1. ; DXDTS Main time frame for data extraction in
  1. ; StartDate^EndDate format
  1. ;
  1. ; Return Values:
  1. ; <0 Error Code
  1. ; 0 Ok
  1. ; >0 Non-fatal error(s)
  1. ;
  1. CSP(RORIENS,DXDTS) ;
  1. N CS,ERRCNT,FLDS,RC,RORMSG,ROROUT,STATUS,TMP
  1. S (ERRCNT,RC)=0
  1. ;--- Check the parameters
  1. S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
  1. ;
  1. S FLDS="1;2;3;3.2;6"
  1. D GETS^DIQ(798,RORIENS,FLDS,"IE","ROROUT","RORMSG")
  1. Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,RORIENS)
  1. I $$ICRDEF^RORHIVUT(+RORIENS) D Q:RC<0 RC
  1. . D GETS^DIQ(799.4,RORIENS,"9.01","IE","ROROUT","RORMSG")
  1. . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,799.4,RORIENS)
  1. ;
  1. S STATUS=+$G(ROROUT(798,RORIENS,3,"I"))
  1. ;--- UPDATE
  1. I $G(DXDTS)>0 D Q:RC<0 RC
  1. . S RC=$$CSPSEG(0,$P(DXDTS,U),$P(DXDTS,U,2))
  1. ;--- SELECT
  1. S RC=$$CSPSEG(1,$G(ROROUT(798,RORIENS,3.2,"I"))) Q:RC<0 RC
  1. ;--- ADD
  1. S RC=$$CSPSEG(2,$G(ROROUT(798,RORIENS,1,"I"))) Q:RC<0 RC
  1. ;--- CONFIRM
  1. I $G(ROROUT(798,RORIENS,2,"I"))>0 D Q:RC<0 RC
  1. . S RC=$$CSPSEG(3,ROROUT(798,RORIENS,2,"I"))
  1. ;--- DELETE
  1. I STATUS=5 D Q:RC<0 RC
  1. . S RC=$$CSPSEG(4,$G(ROROUT(798,RORIENS,6,"I")))
  1. ;--- CDC
  1. I $G(ROROUT(799.4,RORIENS,9.01,"I"))>0 D Q:RC<0 RC
  1. . S RC=$$CSPSEG(5,ROROUT(799.4,RORIENS,9.01,"I"))
  1. ;---
  1. Q ERRCNT
  1. ;
  1. ;***** LOW-LEVEL CSP BUILDER
  1. ;
  1. ; RGEVC Registry event code
  1. ; DATE Event date (FileMan)
  1. ; [ENDT] End date (FileMan)
  1. ;
  1. ; Return Values:
  1. ; <0 Error Code
  1. ; 0 Ok
  1. ;
  1. CSPSEG(RGEVC,DATE,ENDT,CSP4) ;
  1. ;;UPDATE^SELECT^ADD^CONFIRM^DELETE^CDC^MERGE
  1. N CS,RORSEG,TMP
  1. D ECH^RORHL7(.CS)
  1. ;
  1. ;--- Initialize the segment
  1. S RORSEG(0)="CSP"
  1. ;
  1. ;--- CSP-1
  1. S TMP=$S(RGEVC'<0:$P($P($T(CSPSEG+1),";;",2),U,RGEVC+1),1:"")
  1. Q:TMP="" $$ERROR^RORERR(-88,,,,"RGEVC",RGEVC)
  1. S RORSEG(1)=RGEVC_CS_TMP
  1. ;
  1. ;--- CSP-2
  1. S RORSEG(2)=$$FM2HL^RORHL7(DATE)
  1. ;
  1. ;--- CSP-3
  1. S:$G(ENDT)>0 RORSEG(3)=$$FM2HL^RORHL7(ENDT)
  1. ;
  1. ;--- CSP-4
  1. S:$G(CSP4)'?." " RORSEG(4)=CSP4
  1. ;
  1. ;--- Store the segment
  1. D ADDSEG^RORHL7(.RORSEG)
  1. Q 0
  1. ;
  1. ;***** CSR SEGMENT BUILDER
  1. ;
  1. ; [RORIENS] IENS of Patient Record in Registry File. Either this
  1. ; parameter or the PTIEN must have a valid value.
  1. ;
  1. ; [PTIEN] Patient IEN (DFN). If no value is provided for this
  1. ; parameter, then the function uses the value of the
  1. ; .01 field of the patient's registry record.
  1. ;
  1. ; [RORFLDS] Segment Fields to populate
  1. ; (1,3,4,6,9,10,12 available)
  1. ;
  1. ; Return Values:
  1. ; <0 Error Code
  1. ; 0 Ok
  1. ; >0 Non-fatal error(s)
  1. ;
  1. CSR(RORIENS,PTIEN,RORFLDS) ;
  1. N BUF,CS,ERRCNT,HIVIENS,RC,RORMSG,ROROUT,RORSEG,RORTXT,RPS,SCS,TMP,VER
  1. S (ERRCNT,RC)=0,HIVIENS=""
  1. D ECH^RORHL7(.CS,.SCS,.RPS)
  1. S PTIEN=+$G(PTIEN)
  1. ;
  1. I $G(RORIENS)>0 D Q:RC<0 RC
  1. . S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
  1. . D GETS^DIQ(798,RORIENS,".01;.02;1","IE","ROROUT","RORMSG")
  1. . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798,RORIENS) Q
  1. . S:PTIEN'>0 PTIEN=+$G(ROROUT(798,RORIENS,.01,"I"))
  1. . S:$D(^RORDATA(799.4,+RORIENS,0)) HIVIENS=RORIENS
  1. E S RORIENS=""
  1. ;
  1. I $G(RORFLDS)'="" D
  1. . S:$E(RORFLDS)'="," RORFLDS=","_RORFLDS
  1. . S:$E(RORFLDS,$L(RORFLDS))'="," RORFLDS=RORFLDS_","
  1. E S RORFLDS=",1,3,4,6,9,10,12," ; Default HL7 fields
  1. ;
  1. ;--- Initialize the segment
  1. S RORSEG(0)="CSR"
  1. ;
  1. ;--- CSR-1 - Name of the registry and version of the CCR
  1. I RORFLDS[",1," D
  1. . S VER=+$P(ROREXT("VERSION"),U) ; Version
  1. . S:$P(VER,".",2)="" $P(VER,".",2)="0"
  1. . S $P(VER,".",3)=+$P(ROREXT("VERSION"),U,2) ; Patch Number
  1. . S $P(VER,".",4)=+$$BUILD^ROR ; Build Number
  1. . S TMP=$S(RORIENS'="":$G(ROROUT(798,RORIENS,.02,"E")),1:"")
  1. . S RORSEG(1)=$S(TMP'="":TMP,1:"CCR")_CS_VER
  1. ;
  1. ;--- CSR-3 - Institution
  1. I RORFLDS[",3," D
  1. . S RORSEG(3)=$$SITE^RORUTL03(CS)
  1. ;
  1. ;--- CSR-4 - Patient ID
  1. I RORFLDS[",4," D
  1. . S RORSEG(4)=PTIEN_CS_CS_CS_"USVHA"_CS_"PI"
  1. ;
  1. ;--- CSR-6 - Date when added to the registry
  1. I RORFLDS[",6,",RORIENS'="" D Q:RC<0 RC
  1. . S TMP=$$FMTHL7^XLFDT($G(ROROUT(798,RORIENS,1,"I"))\1)
  1. . I TMP'>0 S RC=$$ERROR^RORERR(-95,,,,798,RORIENS,1) Q
  1. . S RORSEG(6)=TMP
  1. ;
  1. ;--- CSR-9 - Date of Clinical AIDS (HIV)
  1. I RORFLDS[",9,",HIVIENS'="" D Q:RC<0 RC
  1. . D GETS^DIQ(799.4,HIVIENS,".02;.03","I","ROROUT","RORMSG")
  1. . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
  1. . . D DBS^RORERR("RORMSG",-9,,,799.4,HIVIENS)
  1. . ;if not 'yes', set date to null
  1. . I $G(ROROUT(799.4,HIVIENS,.02,"I"))'=1 S TMP=""
  1. . E S TMP=$G(ROROUT(799.4,HIVIENS,.03,"I"))
  1. . S RORSEG(9)=$$FM2HL^RORHL7(TMP)
  1. ;
  1. ;--- CSR-10 - Reason for addition of the patient to the registry
  1. I RORFLDS[",10,",RORIENS'="" D Q:RC<0 RC
  1. . S RORSEG(10)=$$ADREASON^RORHLUT1(RORIENS,CS)
  1. ;
  1. ;--- CSR-12 - Risk factors
  1. I RORFLDS[",12,",HIVIENS'="" D Q:RC<0 RC
  1. . N CNT,EV,FLD,RFLST,RORBUF,RORQUIT,RORRISK
  1. . ;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"
  1. . 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"
  1. . D GETS^DIQ(799.4,HIVIENS,RFLST,"I","RORBUF","RORMSG")
  1. . I $G(DIERR) D S ERRCNT=ERRCNT+1
  1. . . D DBS^RORERR("RORMSG",-9,,,799.4,HIVIENS)
  1. . ;---
  1. . S RORRISK="",RORQUIT=0
  1. . F CNT=1:1 S FLD=$P(RFLST,";",CNT) Q:FLD="" D:FLD>0 Q:RORQUIT
  1. . . S TMP=$G(RORBUF(799.4,HIVIENS,FLD,"I"))
  1. . . S EV=$S(TMP=0:"NO",TMP=1:"YES",TMP=9:"UNKNOWN",1:"")
  1. . . ;I EV="" S RORRISK="",RORQUIT=1 Q ;risk factors can be null
  1. . . I $G(EV)="" S TMP=""
  1. . . S $P(RORRISK,RPS,CNT)=$G(TMP)_CS_$G(EV)
  1. . S RORSEG(12)=RORRISK
  1. ;
  1. ;--- Store the segment
  1. D ADDSEG^RORHL7(.RORSEG)
  1. Q $S(RC<0:RC,1:ERRCNT)