RORUPD62 ;HCIOFO/SG - HIV-SPECIFIC REGISTRY UPDATE CODE ; 5/11/05 2:17pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; This routine uses the following IAs:
;
; #2762 Check for the patient merge (controlled)
;
;--------------------------------------------------------------------
; Registry: [VA HIV]
;--------------------------------------------------------------------
Q
;
;***** CONVERTS ICR 2.1 RECORDS TO CCR:HIV FORMAT
;
; RORREG Registry IEN
;
; Return Values:
; <0 Error Code
; 0 Ok
;
CONVERT(RORREG) ;
N CODE,IMRIEN,PATIEN,RC,REGIEN,RULENAME,RULES,TMP
D LOG^RORLOG(2,"ICR 2.1 Conversion")
S REGIEN=+RORREG
;--- Prepare the selection rules
S RULENAME="VA HIV 2.1 CONVERSION"
S TMP=$$SRLIEN^RORUTL02(RULENAME)
Q:TMP'>0 $$ERROR^RORERR(-3,,RULENAME)
S RULES(1)=TMP_U_DT
;--- Convert the remaining records of ICR v2.1
S (IMRIEN,RC)=0
F S IMRIEN=$O(^IMR(158,IMRIEN)) Q:IMRIEN'>0 D Q:RC<0
. S CODE=$P($G(^IMR(158,IMRIEN,0)),U) Q:CODE'>0
. S PATIEN=+$$XOR^RORUTL03(CODE) Q:PATIEN'>0
. ;--- Check if the patient has been merged
. S TMP=+$G(^DPT(PATIEN,-9)) S:TMP>0 PATIEN=TMP
. ;--- Check if the patient record in the file #2 is valid
. Q:$$CHKPTR^RORUTL05(PATIEN)<0
. ;--- Quit if the patient has already been added to the new registry
. Q:$$PRRIEN^RORUTL01(PATIEN,REGIEN)>0
. ;--- Check if the patient is an employee
. Q:$$SKIPEMPL^RORUTL02(PATIEN,.REGIEN)
. ;--- Add the patient to the new registry
. S TMP=$$ADDPAT^RORUPD06(PATIEN,"VA HIV",.RULES)
;---
Q $S(RC<0:RC,1:0)
;
;***** AFTER UPDATE CALL-BACK ENTRY POINT
;
; RORIEN An IEN of the newly added registry record
; PATIEN Patient IEN
; REGIEN Registry IEN
;
; Return Values:
; <0 Error Code
; 0 Ok
;
POSTUPD(RORIEN,PATIEN,REGIEN) ;
N DA,DIK,IENS,RC,RORFDA,RORHIV,RORMSG
S RORIEN=+$G(RORIEN) Q:RORIEN'>0 0
;--- Delete the record if it exists by some reason
D:$D(^RORDATA(799.4,RORIEN))
. S DIK="^RORDATA(799.4,",DA=RORIEN D ^DIK
;--- Prepare the data
S IENS="+1,"
S RORFDA(799.4,IENS,.01)=RORIEN
S RORHIV(1)=RORIEN
;--- Add the record to the ROR HIV STUDY file
D UPDATE^DIE(,"RORFDA","RORHIV","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPD62 2332 printed Apr 09, 2024@20:49:52 Page 2
RORUPD62 ;HCIOFO/SG - HIV-SPECIFIC REGISTRY UPDATE CODE ; 5/11/05 2:17pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #2762 Check for the patient merge (controlled)
+6 ;
+7 ;--------------------------------------------------------------------
+8 ; Registry: [VA HIV]
+9 ;--------------------------------------------------------------------
+10 QUIT
+11 ;
+12 ;***** CONVERTS ICR 2.1 RECORDS TO CCR:HIV FORMAT
+13 ;
+14 ; RORREG Registry IEN
+15 ;
+16 ; Return Values:
+17 ; <0 Error Code
+18 ; 0 Ok
+19 ;
CONVERT(RORREG) ;
+1 NEW CODE,IMRIEN,PATIEN,RC,REGIEN,RULENAME,RULES,TMP
+2 DO LOG^RORLOG(2,"ICR 2.1 Conversion")
+3 SET REGIEN=+RORREG
+4 ;--- Prepare the selection rules
+5 SET RULENAME="VA HIV 2.1 CONVERSION"
+6 SET TMP=$$SRLIEN^RORUTL02(RULENAME)
+7 if TMP'>0
QUIT $$ERROR^RORERR(-3,,RULENAME)
+8 SET RULES(1)=TMP_U_DT
+9 ;--- Convert the remaining records of ICR v2.1
+10 SET (IMRIEN,RC)=0
+11 FOR
SET IMRIEN=$ORDER(^IMR(158,IMRIEN))
if IMRIEN'>0
QUIT
Begin DoDot:1
+12 SET CODE=$PIECE($GET(^IMR(158,IMRIEN,0)),U)
if CODE'>0
QUIT
+13 SET PATIEN=+$$XOR^RORUTL03(CODE)
if PATIEN'>0
QUIT
+14 ;--- Check if the patient has been merged
+15 SET TMP=+$GET(^DPT(PATIEN,-9))
if TMP>0
SET PATIEN=TMP
+16 ;--- Check if the patient record in the file #2 is valid
+17 if $$CHKPTR^RORUTL05(PATIEN)<0
QUIT
+18 ;--- Quit if the patient has already been added to the new registry
+19 if $$PRRIEN^RORUTL01(PATIEN,REGIEN)>0
QUIT
+20 ;--- Check if the patient is an employee
+21 if $$SKIPEMPL^RORUTL02(PATIEN,.REGIEN)
QUIT
+22 ;--- Add the patient to the new registry
+23 SET TMP=$$ADDPAT^RORUPD06(PATIEN,"VA HIV",.RULES)
End DoDot:1
if RC<0
QUIT
+24 ;---
+25 QUIT $SELECT(RC<0:RC,1:0)
+26 ;
+27 ;***** AFTER UPDATE CALL-BACK ENTRY POINT
+28 ;
+29 ; RORIEN An IEN of the newly added registry record
+30 ; PATIEN Patient IEN
+31 ; REGIEN Registry IEN
+32 ;
+33 ; Return Values:
+34 ; <0 Error Code
+35 ; 0 Ok
+36 ;
POSTUPD(RORIEN,PATIEN,REGIEN) ;
+1 NEW DA,DIK,IENS,RC,RORFDA,RORHIV,RORMSG
+2 SET RORIEN=+$GET(RORIEN)
if RORIEN'>0
QUIT 0
+3 ;--- Delete the record if it exists by some reason
+4 if $DATA(^RORDATA(799.4,RORIEN))
Begin DoDot:1
+5 SET DIK="^RORDATA(799.4,"
SET DA=RORIEN
DO ^DIK
End DoDot:1
+6 ;--- Prepare the data
+7 SET IENS="+1,"
+8 SET RORFDA(799.4,IENS,.01)=RORIEN
+9 SET RORHIV(1)=RORIEN
+10 ;--- Add the record to the ROR HIV STUDY file
+11 DO UPDATE^DIE(,"RORFDA","RORHIV","RORMSG")
+12 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
+13 QUIT 0
