RORHIVUT ;HCIOFO/SG - HIV UTILITIES ;9/14/05 8:15am
;;1.5;CLINICAL CASE REGISTRIES;**14**;Feb 17, 2006;Build 24
;
Q
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*14 APR 2011 A SAUNDERS CLINAIDS: also quit if 'unknown'
;******************************************************************************
;******************************************************************************
;
;***** RETURNS THE CATEGORY SUBSCRIPT AND HEADER
CAT(I) ;
;;ALL^AIDS^HIV
;;All Patients^AIDS OI^HIV+ (no AIDS OI)
;
Q $P($P($T(CAT+1),";;",2),U,I)_U_$P($P($T(CAT+2),";;",2),U,I)
;
;***** RETURNS CLINICAL AIDS STATUS OF THE PATIENT
;
; IEN IEN of the registry record
;
; [DATE] Date that the status should be determined on.
;
; If not defined or not greater than 0 then the
; date of Clinical AIDS is not checked.
;
; Return Values:
; 0 No Clinical AIDS
; 1 Clinical AIDS. The second "^"-piece will
; contain the Clinical AIDS date
;
CLINAIDS(IEN,DATE) ;
N X S X=$P($G(^RORDATA(799.4,+IEN,0)),U,2,3)
Q:'X 0 ;quit if 'no' or null in first piece (clinical aids indicator)
I +$G(X)=9 Q 0 ;quit if 'unknown'
I $G(DATE)>0 Q:$P(X,U,2)\1>DATE 0
Q "1"_U_$P(X,U,2)
;
;***** CHECKS IF THE ICR RECORD EXISTS
;
; IEN IEN of the registry record
;
; Return Values:
; 0 Record does not exist
; 1 The ICR record exists
;
ICRDEF(IEN) ;
Q $G(^RORDATA(799.4,+IEN,0))>0
;
;***** RETURNS NUMBER OF AVAILABLE CATEGORIES
NCAT() ;
Q $L($P($T(CAT+1),";;",2),U)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHIVUT 1945 printed Sep 23, 2025@19:17:42 Page 2
RORHIVUT ;HCIOFO/SG - HIV UTILITIES ;9/14/05 8:15am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**14**;Feb 17, 2006;Build 24
+2 ;
+3 QUIT
+4 ;******************************************************************************
+5 ;******************************************************************************
+6 ; --- ROUTINE MODIFICATION LOG ---
+7 ;
+8 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+9 ;----------- ---------- ----------- ----------------------------------------
+10 ;ROR*1.5*14 APR 2011 A SAUNDERS CLINAIDS: also quit if 'unknown'
+11 ;******************************************************************************
+12 ;******************************************************************************
+13 ;
+14 ;***** RETURNS THE CATEGORY SUBSCRIPT AND HEADER
CAT(I) ;
+1 ;;ALL^AIDS^HIV
+2 ;;All Patients^AIDS OI^HIV+ (no AIDS OI)
+3 ;
+4 QUIT $PIECE($PIECE($TEXT(CAT+1),";;",2),U,I)_U_$PIECE($PIECE($TEXT(CAT+2),";;",2),U,I)
+5 ;
+6 ;***** RETURNS CLINICAL AIDS STATUS OF THE PATIENT
+7 ;
+8 ; IEN IEN of the registry record
+9 ;
+10 ; [DATE] Date that the status should be determined on.
+11 ;
+12 ; If not defined or not greater than 0 then the
+13 ; date of Clinical AIDS is not checked.
+14 ;
+15 ; Return Values:
+16 ; 0 No Clinical AIDS
+17 ; 1 Clinical AIDS. The second "^"-piece will
+18 ; contain the Clinical AIDS date
+19 ;
CLINAIDS(IEN,DATE) ;
+1 NEW X
SET X=$PIECE($GET(^RORDATA(799.4,+IEN,0)),U,2,3)
+2 ;quit if 'no' or null in first piece (clinical aids indicator)
if 'X
QUIT 0
+3 ;quit if 'unknown'
IF +$GET(X)=9
QUIT 0
+4 IF $GET(DATE)>0
if $PIECE(X,U,2)\1>DATE
QUIT 0
+5 QUIT "1"_U_$PIECE(X,U,2)
+6 ;
+7 ;***** CHECKS IF THE ICR RECORD EXISTS
+8 ;
+9 ; IEN IEN of the registry record
+10 ;
+11 ; Return Values:
+12 ; 0 Record does not exist
+13 ; 1 The ICR record exists
+14 ;
ICRDEF(IEN) ;
+1 QUIT $GET(^RORDATA(799.4,+IEN,0))>0
+2 ;
+3 ;***** RETURNS NUMBER OF AVAILABLE CATEGORIES
NCAT() ;
+1 QUIT $LENGTH($PIECE($TEXT(CAT+1),";;",2),U)
