RORDD01 ;HCIOFO/SG - DATA DICTIONARY UTILITIES ;6/14/06 2:07pm
;;1.5;CLINICAL CASE REGISTRIES;**1,14**;Feb 17, 2006;Build 24
;
; This routine uses the following IAs:
;
; #2762 ^DPT(D0,-9 (controlled)
;
Q
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*14 APR 2011 A SAUNDERS AIDSOI: Since clinical aids can be 9
; 'unknown', we can't just quit if field
; value is not zero. Only quit if 'yes'.
;******************************************************************************
;******************************************************************************
;
;***** "AIDSOI" TRIGGER OF THE "AIDS INDICATOR DISEASE" MULTIPLE
;
; .SDA Reference to a local array of record IENs
;
; DATE Date of an AIDS indicator disease
;
AIDSOI(SDA,DATE) ;
N IENS,TMP,RORFDA,RORMSG
;--- Do not do anything if the CLINICAL AIDS field is already set
S IENS=+$G(SDA(1)) Q:IENS'>0 S IENS=IENS_","
;Q:$$GET1^DIQ(799.4,IENS,.02,"I",,"RORMSG")
I $$GET1^DIQ(799.4,IENS,.02,"I",,"RORMSG")=1 Q
;---
S DATE=$P(DATE,".")
I DATE>0 D
. S:'$E(DATE,4,5) $E(DATE,4,5)="01"
. S:'$E(DATE,6,7) $E(DATE,6,7)="01"
E S DATE=$$DT^XLFDT
;---
S RORFDA(799.4,IENS,.02)=1
S RORFDA(799.4,IENS,.03)=DATE
D FILE^DIE(,"RORFDA","RORMSG")
Q
;
;***** "ANC" INDEX OF THE "REGISTRY NAME" MULTIPLE OF THE FILE #799.6
;
; .SDA Reference to a local array of record IENs
;
; REGNAME Registry name
;
; MODE 1 - Set, 0 - Kill
;
ANC7996(SDA,REGNAME,MODE) ;
I MODE S MODE=($D(^RORDATA(799.6,SDA(1),3,"ANC"))>1) D
. S ^RORDATA(799.6,SDA(1),3,"ANC",$E(REGNAME,1,30),SDA)=""
E D S MODE=($D(^RORDATA(799.6,SDA(1),3,"ANC"))>1)
. K ^RORDATA(799.6,SDA(1),3,"ANC",$E(REGNAME,1,30),SDA)
Q:MODE
;--- Re-index the main record (the "ADNAUTO" index, in particular)
N DA,DIK
S DIK="^RORDATA(799.6,",DIK(1)=".01",DA=SDA(1)
D EN^DIK
Q
;
;***** DELETES THE DATA ASSOCIATED WITH THE MAIN REGISTRY RECORD
;
; IEN IEN of the registry record (file #798)
; PTIEN Patient IEN
;
DEL798(IEN,PTIEN) ;
N DA,DIK,I,PTDEL
;--- Delete the HIV record from the ROR HIV RECORD file (#799.4)
I $D(^RORDATA(799.4,IEN)) S DIK="^RORDATA(799.4,",DA=IEN D ^DIK
;--- Check if the patient is added to more than one registry
S I="",PTDEL=1
F S I=$O(^RORDATA(798,"B",PTIEN,I)) Q:I="" S:I'=IEN PTDEL=0
;--- Delete corresponding patient's records if they are not
; referenced by other registries and the patient's record
;--- in the PATIENT file (#2) is not a "merged" one.
I PTDEL D:$G(^DPT(PTIEN,-9))'>0
. ;--- Delete the record from the ROR PATIENT file
. S DIK="^RORDATA(798.4,",DA=PTIEN D ^DIK
. ;--- Delete the record from the ROR PATIENT EVENTS file
. S DIK="^RORDATA(798.3,",DA=PTIEN D ^DIK
Q
;
;***** RETURNS THE VALUE OF 'DATE SELECTED' COMPUTED FIELD
;
; IEN IEN of the registry record (file #798)
;
DTSEL(IEN) ;
N DTSEL
;--- Earliest date of a selection rule
S DTSEL=$O(^RORDATA(798,IEN,1,"AD",""))\1
;--- If SELECTION RULE multiple is empty, return DATE ENTERED
Q $S(DTSEL>0:DTSEL,1:$P($G(^RORDATA(798,IEN,0)),U,3)\1)
;
;***** STORE THE VALUE INTO THE FIELD
;
; FILE Sub(file) number
; IENS IENS of the record
; FIELD Field number
; VALUE Internal value to be assigned
;
FILE(FILE,IENS,FIELD,VALUE) ;
N ROR8FDA,ROR8MSG,TMP
S TMP=$S($E(IENS,$L(IENS))=",":IENS,1:IENS_",")
S ROR8FDA(+FILE,TMP,+FIELD)=VALUE
D FILE^DIE(,"ROR8FDA","ROR8MSG")
Q
;
;***** STATUS OF THE HISTORICAL DATA DEFINITION
;
; HDEIEN IEN of the HDE definition (file #799.6)
;
; Return Values:
; "" Unknown/Undefined
; 0 Inactive
; 1 Pending/Active
; 2 Completed
;
HDESTAT(HDEIEN) ;
N BUF,STATUS,TYPE
S HDEIEN=+HDEIEN,BUF=$G(^RORDATA(799.6,HDEIEN,0))
S TYPE=+$P(BUF,U,2),STATUS=""
;=== Auto
I TYPE=1 D Q STATUS
. N ADT
. ;--- Activation Date
. S ADT=+$P(BUF,U,7)
. I (ADT'>0)!(ADT<DT) S STATUS=0 Q
. ;--- Check if all registries have completion dates
. I $D(^RORDATA(799.6,HDEIEN,3,"ANC"))<10 S STATUS=2 Q
. ;--- Pending or Active
. S STATUS=1
;=== Manual
I TYPE=2 D Q STATUS
. N TSKIEN,TSKSTAT
. ;--- Check if any tasks are defined
. I $O(^RORDATA(799.6,HDEIEN,4,0))'>0 S STATUS=0 Q
. ;--- Check if all tasks have been completed
. I $D(^RORDATA(799.6,HDEIEN,4,"ANC"))<10 S STATUS=2 Q
. ;--- Pending, Active, or Errors
. S STATUS=1
;=== Unknown or Undefined
Q ""
;
;***** CHECKS IF THE LOCAL REGISTRY FIELD IS ACTIVE
;
; IEN IEN of the local field definition (file #799.53)
;
; Return Values:
; 0 Inactivated
; 1 Active
;
LFACTIVE(IEN) ;
N TMP
S TMP=$G(^ROR(799.53,+IEN,0)) Q:TMP="" 0
S TMP=$P(TMP,U,2)\1 Q:TMP'>0 1
Q (TMP>DT)
;
;***** RETURNS THE VALUE OF 'LOCATION' COMPUTED FIELD
;
; IEN IEN of the registry record (file #798)
;
LOCSEL(IEN) ;
N DTSEL,SRIEN
S DTSEL=$O(^RORDATA(798,IEN,1,"AD","")) Q:DTSEL'>0 ""
S SRIEN=$O(^RORDATA(798,IEN,1,"AD",DTSEL,""))
Q $S(SRIEN>0:$P($G(^RORDATA(798,IEN,1,SRIEN,0)),U,3),1:"")
;
;***** RE-INDEXES ONE RECORD OF THE (SUB)FILE
;
; FILE File number
;
; .DA Reference to a local array of record IENs
;
; [FIELD] Optional field number. If it is provided, then only
; cross-references for this field are re-indexed.
;
REINDEX1(FILE,DA,FIELD) ;
N DIK
S DIK=$$ROOT^DILFD(FILE,$$IENS^DILF(.DA))
S:$G(FIELD)>0 DIK(1)=+FIELD
D EN^DIK
Q
;
;***** REACTS ON THE REGISTRY RECORD STATUS CHANGES
;
; MODE Execution mode (1 - Set, 2 - Kill)
;
; IEN Internal entry number of the registry record
;
; STOLD Old and new internal values of the STATUS field
; STNEW
;
RST798(MODE,IEN,STOLD,STNEW) ;
Q:STNEW=STOLD
N IENS,RORFDA,RORMSG
S IENS=(+IEN)_","
;---
D
. ;--- Deleted
. I STNEW=5 D Q
. . S RORFDA(798,IENS,6)=$$NOW^XLFDT
. . S:$G(DUZ)>0 RORFDA(798,IENS,6.1)=+DUZ
. ;--- Confirmed
. I STOLD=4,'STNEW D Q
. . S RORFDA(798,IENS,2)=$$NOW^XLFDT
. . S:$G(DUZ)>0 RORFDA(798,IENS,2.1)=+DUZ
;---
D:$D(RORFDA)>1 FILE^DIE(,"RORFDA","RORMSG")
Q
;
;***** GENERATES THE INDEX VALUE OF THE REPORT ELEMENT
;
; MODE Sort mode (see the SORT BY field of the REPORT
; ELEMENT multiple of the ROR TASK file for details)
; VAL Value of the report element
;
SORTBY(MODE,VAL) ;
Q $S(MODE=3:+VAL,VAL="":" ",MODE=2:$E(VAL,1,29)_" ",1:$E(VAL,1,30))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORDD01 7081 printed Dec 13, 2024@01:41:23 Page 2
RORDD01 ;HCIOFO/SG - DATA DICTIONARY UTILITIES ;6/14/06 2:07pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,14**;Feb 17, 2006;Build 24
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #2762 ^DPT(D0,-9 (controlled)
+6 ;
+7 QUIT
+8 ;******************************************************************************
+9 ;******************************************************************************
+10 ; --- ROUTINE MODIFICATION LOG ---
+11 ;
+12 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+13 ;----------- ---------- ----------- ----------------------------------------
+14 ;ROR*1.5*14 APR 2011 A SAUNDERS AIDSOI: Since clinical aids can be 9
+15 ; 'unknown', we can't just quit if field
+16 ; value is not zero. Only quit if 'yes'.
+17 ;******************************************************************************
+18 ;******************************************************************************
+19 ;
+20 ;***** "AIDSOI" TRIGGER OF THE "AIDS INDICATOR DISEASE" MULTIPLE
+21 ;
+22 ; .SDA Reference to a local array of record IENs
+23 ;
+24 ; DATE Date of an AIDS indicator disease
+25 ;
AIDSOI(SDA,DATE) ;
+1 NEW IENS,TMP,RORFDA,RORMSG
+2 ;--- Do not do anything if the CLINICAL AIDS field is already set
+3 SET IENS=+$GET(SDA(1))
if IENS'>0
QUIT
SET IENS=IENS_","
+4 ;Q:$$GET1^DIQ(799.4,IENS,.02,"I",,"RORMSG")
+5 IF $$GET1^DIQ(799.4,IENS,.02,"I",,"RORMSG")=1
QUIT
+6 ;---
+7 SET DATE=$PIECE(DATE,".")
+8 IF DATE>0
Begin DoDot:1
+9 if '$EXTRACT(DATE,4,5)
SET $EXTRACT(DATE,4,5)="01"
+10 if '$EXTRACT(DATE,6,7)
SET $EXTRACT(DATE,6,7)="01"
End DoDot:1
+11 IF '$TEST
SET DATE=$$DT^XLFDT
+12 ;---
+13 SET RORFDA(799.4,IENS,.02)=1
+14 SET RORFDA(799.4,IENS,.03)=DATE
+15 DO FILE^DIE(,"RORFDA","RORMSG")
+16 QUIT
+17 ;
+18 ;***** "ANC" INDEX OF THE "REGISTRY NAME" MULTIPLE OF THE FILE #799.6
+19 ;
+20 ; .SDA Reference to a local array of record IENs
+21 ;
+22 ; REGNAME Registry name
+23 ;
+24 ; MODE 1 - Set, 0 - Kill
+25 ;
ANC7996(SDA,REGNAME,MODE) ;
+1 IF MODE
SET MODE=($DATA(^RORDATA(799.6,SDA(1),3,"ANC"))>1)
Begin DoDot:1
+2 SET ^RORDATA(799.6,SDA(1),3,"ANC",$EXTRACT(REGNAME,1,30),SDA)=""
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 KILL ^RORDATA(799.6,SDA(1),3,"ANC",$EXTRACT(REGNAME,1,30),SDA)
End DoDot:1
SET MODE=($DATA(^RORDATA(799.6,SDA(1),3,"ANC"))>1)
+5 if MODE
QUIT
+6 ;--- Re-index the main record (the "ADNAUTO" index, in particular)
+7 NEW DA,DIK
+8 SET DIK="^RORDATA(799.6,"
SET DIK(1)=".01"
SET DA=SDA(1)
+9 DO EN^DIK
+10 QUIT
+11 ;
+12 ;***** DELETES THE DATA ASSOCIATED WITH THE MAIN REGISTRY RECORD
+13 ;
+14 ; IEN IEN of the registry record (file #798)
+15 ; PTIEN Patient IEN
+16 ;
DEL798(IEN,PTIEN) ;
+1 NEW DA,DIK,I,PTDEL
+2 ;--- Delete the HIV record from the ROR HIV RECORD file (#799.4)
+3 IF $DATA(^RORDATA(799.4,IEN))
SET DIK="^RORDATA(799.4,"
SET DA=IEN
DO ^DIK
+4 ;--- Check if the patient is added to more than one registry
+5 SET I=""
SET PTDEL=1
+6 FOR
SET I=$ORDER(^RORDATA(798,"B",PTIEN,I))
if I=""
QUIT
if I'=IEN
SET PTDEL=0
+7 ;--- Delete corresponding patient's records if they are not
+8 ; referenced by other registries and the patient's record
+9 ;--- in the PATIENT file (#2) is not a "merged" one.
+10 IF PTDEL
if $GET(^DPT(PTIEN,-9))'>0
Begin DoDot:1
+11 ;--- Delete the record from the ROR PATIENT file
+12 SET DIK="^RORDATA(798.4,"
SET DA=PTIEN
DO ^DIK
+13 ;--- Delete the record from the ROR PATIENT EVENTS file
+14 SET DIK="^RORDATA(798.3,"
SET DA=PTIEN
DO ^DIK
End DoDot:1
+15 QUIT
+16 ;
+17 ;***** RETURNS THE VALUE OF 'DATE SELECTED' COMPUTED FIELD
+18 ;
+19 ; IEN IEN of the registry record (file #798)
+20 ;
DTSEL(IEN) ;
+1 NEW DTSEL
+2 ;--- Earliest date of a selection rule
+3 SET DTSEL=$ORDER(^RORDATA(798,IEN,1,"AD",""))\1
+4 ;--- If SELECTION RULE multiple is empty, return DATE ENTERED
+5 QUIT $SELECT(DTSEL>0:DTSEL,1:$PIECE($GET(^RORDATA(798,IEN,0)),U,3)\1)
+6 ;
+7 ;***** STORE THE VALUE INTO THE FIELD
+8 ;
+9 ; FILE Sub(file) number
+10 ; IENS IENS of the record
+11 ; FIELD Field number
+12 ; VALUE Internal value to be assigned
+13 ;
FILE(FILE,IENS,FIELD,VALUE) ;
+1 NEW ROR8FDA,ROR8MSG,TMP
+2 SET TMP=$SELECT($EXTRACT(IENS,$LENGTH(IENS))=",":IENS,1:IENS_",")
+3 SET ROR8FDA(+FILE,TMP,+FIELD)=VALUE
+4 DO FILE^DIE(,"ROR8FDA","ROR8MSG")
+5 QUIT
+6 ;
+7 ;***** STATUS OF THE HISTORICAL DATA DEFINITION
+8 ;
+9 ; HDEIEN IEN of the HDE definition (file #799.6)
+10 ;
+11 ; Return Values:
+12 ; "" Unknown/Undefined
+13 ; 0 Inactive
+14 ; 1 Pending/Active
+15 ; 2 Completed
+16 ;
HDESTAT(HDEIEN) ;
+1 NEW BUF,STATUS,TYPE
+2 SET HDEIEN=+HDEIEN
SET BUF=$GET(^RORDATA(799.6,HDEIEN,0))
+3 SET TYPE=+$PIECE(BUF,U,2)
SET STATUS=""
+4 ;=== Auto
+5 IF TYPE=1
Begin DoDot:1
+6 NEW ADT
+7 ;--- Activation Date
+8 SET ADT=+$PIECE(BUF,U,7)
+9 IF (ADT'>0)!(ADT<DT)
SET STATUS=0
QUIT
+10 ;--- Check if all registries have completion dates
+11 IF $DATA(^RORDATA(799.6,HDEIEN,3,"ANC"))<10
SET STATUS=2
QUIT
+12 ;--- Pending or Active
+13 SET STATUS=1
End DoDot:1
QUIT STATUS
+14 ;=== Manual
+15 IF TYPE=2
Begin DoDot:1
+16 NEW TSKIEN,TSKSTAT
+17 ;--- Check if any tasks are defined
+18 IF $ORDER(^RORDATA(799.6,HDEIEN,4,0))'>0
SET STATUS=0
QUIT
+19 ;--- Check if all tasks have been completed
+20 IF $DATA(^RORDATA(799.6,HDEIEN,4,"ANC"))<10
SET STATUS=2
QUIT
+21 ;--- Pending, Active, or Errors
+22 SET STATUS=1
End DoDot:1
QUIT STATUS
+23 ;=== Unknown or Undefined
+24 QUIT ""
+25 ;
+26 ;***** CHECKS IF THE LOCAL REGISTRY FIELD IS ACTIVE
+27 ;
+28 ; IEN IEN of the local field definition (file #799.53)
+29 ;
+30 ; Return Values:
+31 ; 0 Inactivated
+32 ; 1 Active
+33 ;
LFACTIVE(IEN) ;
+1 NEW TMP
+2 SET TMP=$GET(^ROR(799.53,+IEN,0))
if TMP=""
QUIT 0
+3 SET TMP=$PIECE(TMP,U,2)\1
if TMP'>0
QUIT 1
+4 QUIT (TMP>DT)
+5 ;
+6 ;***** RETURNS THE VALUE OF 'LOCATION' COMPUTED FIELD
+7 ;
+8 ; IEN IEN of the registry record (file #798)
+9 ;
LOCSEL(IEN) ;
+1 NEW DTSEL,SRIEN
+2 SET DTSEL=$ORDER(^RORDATA(798,IEN,1,"AD",""))
if DTSEL'>0
QUIT ""
+3 SET SRIEN=$ORDER(^RORDATA(798,IEN,1,"AD",DTSEL,""))
+4 QUIT $SELECT(SRIEN>0:$PIECE($GET(^RORDATA(798,IEN,1,SRIEN,0)),U,3),1:"")
+5 ;
+6 ;***** RE-INDEXES ONE RECORD OF THE (SUB)FILE
+7 ;
+8 ; FILE File number
+9 ;
+10 ; .DA Reference to a local array of record IENs
+11 ;
+12 ; [FIELD] Optional field number. If it is provided, then only
+13 ; cross-references for this field are re-indexed.
+14 ;
REINDEX1(FILE,DA,FIELD) ;
+1 NEW DIK
+2 SET DIK=$$ROOT^DILFD(FILE,$$IENS^DILF(.DA))
+3 if $GET(FIELD)>0
SET DIK(1)=+FIELD
+4 DO EN^DIK
+5 QUIT
+6 ;
+7 ;***** REACTS ON THE REGISTRY RECORD STATUS CHANGES
+8 ;
+9 ; MODE Execution mode (1 - Set, 2 - Kill)
+10 ;
+11 ; IEN Internal entry number of the registry record
+12 ;
+13 ; STOLD Old and new internal values of the STATUS field
+14 ; STNEW
+15 ;
RST798(MODE,IEN,STOLD,STNEW) ;
+1 if STNEW=STOLD
QUIT
+2 NEW IENS,RORFDA,RORMSG
+3 SET IENS=(+IEN)_","
+4 ;---
+5 Begin DoDot:1
+6 ;--- Deleted
+7 IF STNEW=5
Begin DoDot:2
+8 SET RORFDA(798,IENS,6)=$$NOW^XLFDT
+9 if $GET(DUZ)>0
SET RORFDA(798,IENS,6.1)=+DUZ
End DoDot:2
QUIT
+10 ;--- Confirmed
+11 IF STOLD=4
IF 'STNEW
Begin DoDot:2
+12 SET RORFDA(798,IENS,2)=$$NOW^XLFDT
+13 if $GET(DUZ)>0
SET RORFDA(798,IENS,2.1)=+DUZ
End DoDot:2
QUIT
End DoDot:1
+14 ;---
+15 if $DATA(RORFDA)>1
DO FILE^DIE(,"RORFDA","RORMSG")
+16 QUIT
+17 ;
+18 ;***** GENERATES THE INDEX VALUE OF THE REPORT ELEMENT
+19 ;
+20 ; MODE Sort mode (see the SORT BY field of the REPORT
+21 ; ELEMENT multiple of the ROR TASK file for details)
+22 ; VAL Value of the report element
+23 ;
SORTBY(MODE,VAL) ;
+1 QUIT $SELECT(MODE=3:+VAL,VAL="":" ",MODE=2:$EXTRACT(VAL,1,29)_" ",1:$EXTRACT(VAL,1,30))
