source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQADM23.m@ 1696

Last change on this file since 1696 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1VAQADM23 ;ALB/JRP - MESSAGE ADMINISTRATION;13-SEP-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3MAXCHCK(SEGARR,OUTARR) ;CHECK SEGMENTS AGAINST MAXIMUM LIMITS FOR AUTO PROC.
4 ;INPUT : SEGARR - Array of pointers to VAQ - DATA SEGMENT file
5 ; set equal to the time & occurrence values requested
6 ; (full global reference)
7 ; SEGARR(Pointer)=Time^Occurr
8 ; OUTARR - Array to store output in (full global reference)
9 ; [See OUPUT for format of OUTARR]
10 ;OUTPUT : 0 - All segments OK for automatic processing
11 ; OUTARR will have no entries
12 ; X - Number of segments that can not be automatically processed
13 ; OUTARR(SEGPTR)=MaxTime^MaxOccur^Time^Occur
14 ; -1 - Bad input or error
15 ;NOTES : It is the responsibility of the programmer to ensure that
16 ; OUTARR is killed before and after this call
17 ;
18 ;CHECK INPUT
19 Q:($G(SEGARR)="") ""
20 Q:('$D(@SEGARR))
21 Q:($G(OUTARR)="") ""
22 ;DECLARE VARIABLES
23 N TMP,POINTER,REQTIM,REQOCC,COUNT,OVERMAX
24 ;LOOP THROUGH SEGMENTS
25 S POINTER=""
26 S COUNT=0
27 F S POINTER=+$O(@SEGARR@(POINTER)) Q:('POINTER) D
28 .;NOT A VALID SEGMENT POINTER - IGNORE
29 .Q:('$D(^VAT(394.71,POINTER)))
30 .;GET REQUESTED LIMITS
31 .S TMP=$G(@SEGARR@(POINTER))
32 .S REQTIM=$P(TMP,"^",1)
33 .S REQOCC=$P(TMP,"^",2)
34 .;CHECK LIMITS AGAINST MAX ALLOWED
35 .S OVERMAX=$$CHCKSEG(POINTER,REQTIM,REQOCC)
36 .;OVER ALLOWED LIMITS - INCREMENT COUNT & STORE MAX LIMITS
37 .I (OVERMAX) D
38 ..S COUNT=COUNT+1
39 ..S TMP=$$SEGHLTH^VAQDBIH1(POINTER,0)
40 ..S @OUTARR@(POINTER)=($P(TMP,"^",2,3)_"^"_REQTIM_"^"_REQOCC)
41 ;RETURN NUMBER OF SEGMENTS OVER MAX ALLOWED
42 Q COUNT
43 ;
44CHCKSEG(SEGPTR,TIME,OCCUR) ;CHECK SEGMENT LIMITS AGAINST ALLOWED VALUES
45 ;INPUT : SEGPTR - Pointer to VAQ - DATA SEGMENT file (segment to check)
46 ; TIME - Time limit being requested
47 ; OCCUR - Occurrence limit being requested
48 ;OUTPUT : 0 - Segment OK for automatic processing
49 ; 1 - Segment can not be automatically processed
50 ; -1 - Bad input
51 ;
52 ;CHECK INPUT
53 Q:($G(SEGPTR)="") -1
54 Q:('$D(^VAT(394.71,SEGPTR))) -1
55 S TIME=$G(TIME)
56 S OCCUR=$G(OCCUR)
57 I (TIME'="") Q:($$VALOCC^VAQDBIH2(TIME,0)) -1
58 I (OCCUR'="") Q:($$VALOCC^VAQDBIH2(OCCUR,1)) -1
59 ;DECLARE VARIABLES
60 N TIMLIM,OCCLIM,TMP
61 ;GET ALLOWABLE LIMITS FOR SEGMENT
62 S TMP=$$SEGHLTH^VAQDBIH1(SEGPTR)
63 ;SEGMENT NOT HEALTH SUMMARY COMPONENT (AUTOMATIC PROCESSING ALLOWED)
64 Q:('TMP) 0
65 S TIMLIM=$P(TMP,"^",2)
66 S OCCLIM=$P(TMP,"^",3)
67 ;CHECK TIME LIMIT
68 I ((TIMLIM'="")&(TIMLIM'="@")) D Q:(TMP) 1
69 .;CONVERT TIME LIMIT REQUESTED TO DAYS
70 .S TMP=$$TIMECHNG(TIME)
71 .I ((TMP="")&(TIME'="")) S TMP=1 Q
72 .S TIME=TMP
73 .;CONVERT ALLOWABLE TIME LIMIT TO DAYS
74 .S TIMLIM=$$TIMECHNG(TIMLIM)
75 .I (TIMLIM="") S TMP=1 Q
76 .;CHECK
77 .I (TIME="") S TMP=1 Q
78 .I (TIME>TIMLIM) S TMP=1 Q
79 .S TMP=0
80 ;CHECK OCCURRENCE LIMIT
81 I ((OCCLIM'="")&(OCCLIM'="@")) D Q:(TMP) 1
82 .S TMP=0
83 .S:(OCCUR>OCCLIM) TMP=1
84 .S:(OCCUR="") TMP=1
85 ;AUTOMATIC PROCESSING ALLOWED
86 Q 0
87 ;
88TIMECHNG(INTIME) ;CONVERT TIME LIMIT TO DAYS
89 ;INPUT : INTIME - Valid time limit to convert
90 ;OUTPUT : X - INTIME in days (ex: '1Y' results in '365')
91 ; NULL will be returned on error
92 ;NOTES : The following assumptions are made
93 ; 1) There are 365 days in a year
94 ; 2) There are 30 days in a month
95 ;
96 ;CHECK INPUT
97 Q:($$VALOCC^VAQDBIH2($G(INTIME),0)) ""
98 ;DECLARE VARIABLES
99 N TYPE,VALUE
100 ;BREAK LIMIT INTO IT'S VALUE AND TYPE
101 S VALUE=$E(INTIME,1,($L(INTIME)-1))
102 S TYPE=$E(INTIME,$L(INTIME))
103 ;INTIME ALREADY IN DAYS
104 Q:(TYPE="D") (+INTIME)
105 ;CONVERT YEARS TO DAYS
106 Q:(TYPE="Y") (VALUE*365)
107 ;CONVERT MONTHS TO DAYS
108 Q:(TYPE="M") (VALUE*30)
109 ;ERROR
110 Q ("")
Note: See TracBrowser for help on using the repository browser.