source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL02.m@ 1532

RORHL02 ;HOIFO/CRT,SG - HL7 REGISTRY DATA: CSP,CSR,CSS ; 12/6/05 2:36pm
 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
 ;
 Q
 ;
 ;***** 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)
 . I '$G(ROROUT(799.4,HIVIENS,.02,"I"))  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"
 . 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
 . . S $P(RORRISK,RPS,CNT)=TMP_CS_EV
 . S RORSEG(12)=RORRISK
 ;
 ;--- Store the segment
 D ADDSEG^RORHL7(.RORSEG)
 Q $S(RC<0:RC,1:ERRCNT)