VAQADM23 ;ALB/JRP - MESSAGE ADMINISTRATION;13-SEP-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MAXCHCK(SEGARR,OUTARR) ;CHECK SEGMENTS AGAINST MAXIMUM LIMITS FOR AUTO PROC.
;INPUT : SEGARR - Array of pointers to VAQ - DATA SEGMENT file
; set equal to the time & occurrence values requested
; (full global reference)
; SEGARR(Pointer)=Time^Occurr
; OUTARR - Array to store output in (full global reference)
; [See OUPUT for format of OUTARR]
;OUTPUT : 0 - All segments OK for automatic processing
; OUTARR will have no entries
; X - Number of segments that can not be automatically processed
; OUTARR(SEGPTR)=MaxTime^MaxOccur^Time^Occur
; -1 - Bad input or error
;NOTES : It is the responsibility of the programmer to ensure that
; OUTARR is killed before and after this call
;
;CHECK INPUT
Q:($G(SEGARR)="") ""
Q:('$D(@SEGARR))
Q:($G(OUTARR)="") ""
;DECLARE VARIABLES
N TMP,POINTER,REQTIM,REQOCC,COUNT,OVERMAX
;LOOP THROUGH SEGMENTS
S POINTER=""
S COUNT=0
F S POINTER=+$O(@SEGARR@(POINTER)) Q:('POINTER) D
.;NOT A VALID SEGMENT POINTER - IGNORE
.Q:('$D(^VAT(394.71,POINTER)))
.;GET REQUESTED LIMITS
.S TMP=$G(@SEGARR@(POINTER))
.S REQTIM=$P(TMP,"^",1)
.S REQOCC=$P(TMP,"^",2)
.;CHECK LIMITS AGAINST MAX ALLOWED
.S OVERMAX=$$CHCKSEG(POINTER,REQTIM,REQOCC)
.;OVER ALLOWED LIMITS - INCREMENT COUNT & STORE MAX LIMITS
.I (OVERMAX) D
..S COUNT=COUNT+1
..S TMP=$$SEGHLTH^VAQDBIH1(POINTER,0)
..S @OUTARR@(POINTER)=($P(TMP,"^",2,3)_"^"_REQTIM_"^"_REQOCC)
;RETURN NUMBER OF SEGMENTS OVER MAX ALLOWED
Q COUNT
;
CHCKSEG(SEGPTR,TIME,OCCUR) ;CHECK SEGMENT LIMITS AGAINST ALLOWED VALUES
;INPUT : SEGPTR - Pointer to VAQ - DATA SEGMENT file (segment to check)
; TIME - Time limit being requested
; OCCUR - Occurrence limit being requested
;OUTPUT : 0 - Segment OK for automatic processing
; 1 - Segment can not be automatically processed
; -1 - Bad input
;
;CHECK INPUT
Q:($G(SEGPTR)="") -1
Q:('$D(^VAT(394.71,SEGPTR))) -1
S TIME=$G(TIME)
S OCCUR=$G(OCCUR)
I (TIME'="") Q:($$VALOCC^VAQDBIH2(TIME,0)) -1
I (OCCUR'="") Q:($$VALOCC^VAQDBIH2(OCCUR,1)) -1
;DECLARE VARIABLES
N TIMLIM,OCCLIM,TMP
;GET ALLOWABLE LIMITS FOR SEGMENT
S TMP=$$SEGHLTH^VAQDBIH1(SEGPTR)
;SEGMENT NOT HEALTH SUMMARY COMPONENT (AUTOMATIC PROCESSING ALLOWED)
Q:('TMP) 0
S TIMLIM=$P(TMP,"^",2)
S OCCLIM=$P(TMP,"^",3)
;CHECK TIME LIMIT
I ((TIMLIM'="")&(TIMLIM'="@")) D Q:(TMP) 1
.;CONVERT TIME LIMIT REQUESTED TO DAYS
.S TMP=$$TIMECHNG(TIME)
.I ((TMP="")&(TIME'="")) S TMP=1 Q
.S TIME=TMP
.;CONVERT ALLOWABLE TIME LIMIT TO DAYS
.S TIMLIM=$$TIMECHNG(TIMLIM)
.I (TIMLIM="") S TMP=1 Q
.;CHECK
.I (TIME="") S TMP=1 Q
.I (TIME>TIMLIM) S TMP=1 Q
.S TMP=0
;CHECK OCCURRENCE LIMIT
I ((OCCLIM'="")&(OCCLIM'="@")) D Q:(TMP) 1
.S TMP=0
.S:(OCCUR>OCCLIM) TMP=1
.S:(OCCUR="") TMP=1
;AUTOMATIC PROCESSING ALLOWED
Q 0
;
TIMECHNG(INTIME) ;CONVERT TIME LIMIT TO DAYS
;INPUT : INTIME - Valid time limit to convert
;OUTPUT : X - INTIME in days (ex: '1Y' results in '365')
; NULL will be returned on error
;NOTES : The following assumptions are made
; 1) There are 365 days in a year
; 2) There are 30 days in a month
;
;CHECK INPUT
Q:($$VALOCC^VAQDBIH2($G(INTIME),0)) ""
;DECLARE VARIABLES
N TYPE,VALUE
;BREAK LIMIT INTO IT'S VALUE AND TYPE
S VALUE=$E(INTIME,1,($L(INTIME)-1))
S TYPE=$E(INTIME,$L(INTIME))
;INTIME ALREADY IN DAYS
Q:(TYPE="D") (+INTIME)
;CONVERT YEARS TO DAYS
Q:(TYPE="Y") (VALUE*365)
;CONVERT MONTHS TO DAYS
Q:(TYPE="M") (VALUE*30)
;ERROR
Q ("")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQADM23 3806 printed Apr 09, 2024@21:28:15 Page 2
VAQADM23 ;ALB/JRP - MESSAGE ADMINISTRATION;13-SEP-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MAXCHCK(SEGARR,OUTARR) ;CHECK SEGMENTS AGAINST MAXIMUM LIMITS FOR AUTO PROC.
+1 ;INPUT : SEGARR - Array of pointers to VAQ - DATA SEGMENT file
+2 ; set equal to the time & occurrence values requested
+3 ; (full global reference)
+4 ; SEGARR(Pointer)=Time^Occurr
+5 ; OUTARR - Array to store output in (full global reference)
+6 ; [See OUPUT for format of OUTARR]
+7 ;OUTPUT : 0 - All segments OK for automatic processing
+8 ; OUTARR will have no entries
+9 ; X - Number of segments that can not be automatically processed
+10 ; OUTARR(SEGPTR)=MaxTime^MaxOccur^Time^Occur
+11 ; -1 - Bad input or error
+12 ;NOTES : It is the responsibility of the programmer to ensure that
+13 ; OUTARR is killed before and after this call
+14 ;
+15 ;CHECK INPUT
+16 if ($GET(SEGARR)="")
QUIT ""
+17 if ('$DATA(@SEGARR))
QUIT
+18 if ($GET(OUTARR)="")
QUIT ""
+19 ;DECLARE VARIABLES
+20 NEW TMP,POINTER,REQTIM,REQOCC,COUNT,OVERMAX
+21 ;LOOP THROUGH SEGMENTS
+22 SET POINTER=""
+23 SET COUNT=0
+24 FOR
SET POINTER=+$ORDER(@SEGARR@(POINTER))
if ('POINTER)
QUIT
Begin DoDot:1
+25 ;NOT A VALID SEGMENT POINTER - IGNORE
+26 if ('$DATA(^VAT(394.71,POINTER)))
QUIT
+27 ;GET REQUESTED LIMITS
+28 SET TMP=$GET(@SEGARR@(POINTER))
+29 SET REQTIM=$PIECE(TMP,"^",1)
+30 SET REQOCC=$PIECE(TMP,"^",2)
+31 ;CHECK LIMITS AGAINST MAX ALLOWED
+32 SET OVERMAX=$$CHCKSEG(POINTER,REQTIM,REQOCC)
+33 ;OVER ALLOWED LIMITS - INCREMENT COUNT & STORE MAX LIMITS
+34 IF (OVERMAX)
Begin DoDot:2
+35 SET COUNT=COUNT+1
+36 SET TMP=$$SEGHLTH^VAQDBIH1(POINTER,0)
+37 SET @OUTARR@(POINTER)=($PIECE(TMP,"^",2,3)_"^"_REQTIM_"^"_REQOCC)
End DoDot:2
End DoDot:1
+38 ;RETURN NUMBER OF SEGMENTS OVER MAX ALLOWED
+39 QUIT COUNT
+40 ;
CHCKSEG(SEGPTR,TIME,OCCUR) ;CHECK SEGMENT LIMITS AGAINST ALLOWED VALUES
+1 ;INPUT : SEGPTR - Pointer to VAQ - DATA SEGMENT file (segment to check)
+2 ; TIME - Time limit being requested
+3 ; OCCUR - Occurrence limit being requested
+4 ;OUTPUT : 0 - Segment OK for automatic processing
+5 ; 1 - Segment can not be automatically processed
+6 ; -1 - Bad input
+7 ;
+8 ;CHECK INPUT
+9 if ($GET(SEGPTR)="")
QUIT -1
+10 if ('$DATA(^VAT(394.71,SEGPTR)))
QUIT -1
+11 SET TIME=$GET(TIME)
+12 SET OCCUR=$GET(OCCUR)
+13 IF (TIME'="")
if ($$VALOCC^VAQDBIH2(TIME,0))
QUIT -1
+14 IF (OCCUR'="")
if ($$VALOCC^VAQDBIH2(OCCUR,1))
QUIT -1
+15 ;DECLARE VARIABLES
+16 NEW TIMLIM,OCCLIM,TMP
+17 ;GET ALLOWABLE LIMITS FOR SEGMENT
+18 SET TMP=$$SEGHLTH^VAQDBIH1(SEGPTR)
+19 ;SEGMENT NOT HEALTH SUMMARY COMPONENT (AUTOMATIC PROCESSING ALLOWED)
+20 if ('TMP)
QUIT 0
+21 SET TIMLIM=$PIECE(TMP,"^",2)
+22 SET OCCLIM=$PIECE(TMP,"^",3)
+23 ;CHECK TIME LIMIT
+24 IF ((TIMLIM'="")&(TIMLIM'="@"))
Begin DoDot:1
+25 ;CONVERT TIME LIMIT REQUESTED TO DAYS
+26 SET TMP=$$TIMECHNG(TIME)
+27 IF ((TMP="")&(TIME'=""))
SET TMP=1
QUIT
+28 SET TIME=TMP
+29 ;CONVERT ALLOWABLE TIME LIMIT TO DAYS
+30 SET TIMLIM=$$TIMECHNG(TIMLIM)
+31 IF (TIMLIM="")
SET TMP=1
QUIT
+32 ;CHECK
+33 IF (TIME="")
SET TMP=1
QUIT
+34 IF (TIME>TIMLIM)
SET TMP=1
QUIT
+35 SET TMP=0
End DoDot:1
if (TMP)
QUIT 1
+36 ;CHECK OCCURRENCE LIMIT
+37 IF ((OCCLIM'="")&(OCCLIM'="@"))
Begin DoDot:1
+38 SET TMP=0
+39 if (OCCUR>OCCLIM)
SET TMP=1
+40 if (OCCUR="")
SET TMP=1
End DoDot:1
if (TMP)
QUIT 1
+41 ;AUTOMATIC PROCESSING ALLOWED
+42 QUIT 0
+43 ;
TIMECHNG(INTIME) ;CONVERT TIME LIMIT TO DAYS
+1 ;INPUT : INTIME - Valid time limit to convert
+2 ;OUTPUT : X - INTIME in days (ex: '1Y' results in '365')
+3 ; NULL will be returned on error
+4 ;NOTES : The following assumptions are made
+5 ; 1) There are 365 days in a year
+6 ; 2) There are 30 days in a month
+7 ;
+8 ;CHECK INPUT
+9 if ($$VALOCC^VAQDBIH2($GET(INTIME),0))
QUIT ""
+10 ;DECLARE VARIABLES
+11 NEW TYPE,VALUE
+12 ;BREAK LIMIT INTO IT'S VALUE AND TYPE
+13 SET VALUE=$EXTRACT(INTIME,1,($LENGTH(INTIME)-1))
+14 SET TYPE=$EXTRACT(INTIME,$LENGTH(INTIME))
+15 ;INTIME ALREADY IN DAYS
+16 if (TYPE="D")
QUIT (+INTIME)
+17 ;CONVERT YEARS TO DAYS
+18 if (TYPE="Y")
QUIT (VALUE*365)
+19 ;CONVERT MONTHS TO DAYS
+20 if (TYPE="M")
QUIT (VALUE*30)
+21 ;ERROR
+22 QUIT ("")
