RORUPD62.m

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 ---RORUPD62   2332     printed  Feb 18, 2025@23:10:11                                                                                                                                                                                                    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