source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPUR11.m@ 862

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

initial load of WorldVistAEHR
File size: 3.0 KB
Line 
1VAQPUR11 ;ALB/JRP - PURGING;15JUL93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3PRGCHK(POINTER,PRGDATE,SETPRGE) ;CHECK TO SEE IF TRANSACTION SHOULD BE PURGE
4 ;INPUT : POINTER - Pointer to transaction to check
5 ; PRGDATE - Date purging will be based on (FileMan format)
6 ; SETPRGE - Flag indicating if purge flag should be set
7 ; when required data is not present
8 ; If 0, don't set purge flag (default)
9 ; If 1, set purge flag
10 ;OUTPUT : 0 - Transaction does not require purging
11 ; 1 - Transaction does require purging
12 ; 2^0 - Required info for transaction was not present and
13 ; purge flag was not set
14 ; 2^1 - Required info for transaction was not present and
15 ; purge flag has been set
16 ; 2^-1 - Required info for transaction was not present and
17 ; purge flag could not be set
18 ; 3 - Transaction was already flaged for purging
19 ; -1 - Error determing if transaction should be purged
20 ;
21 ;CHECK INPUT
22 Q:('(+$G(POINTER))) -1
23 Q:('(+$G(PRGDATE))) -1
24 Q:('$D(^VAT(394.61,POINTER))) -1
25 S SETPRGE=+$G(SETPRGE)
26 ;DECLARE VARIABLES
27 N NUMBER,CURTYPE,RELTYPE,NAME,SSN,RQSTDATE
28 N ATHRDATE,SEGS,X1,X2,X,%Y,TMP,FLAG,RQSTOLD,ATHROLD
29 S FLAG=0
30 ;CHECK PURGE FLAG
31 Q:($D(^VAT(394.61,"PURGE",1,POINTER))) 3
32 ;GET REQUIRED INFORMATION
33 ;TRANSACTION NUMBER
34 S NUMBER=+$G(^VAT(394.61,POINTER,0))
35 ;CURRENT TYPE
36 S CURTYPE=""
37 S TMP=$$STATYPE^VAQCON1(POINTER,1)
38 S:($P(TMP,"^",1)'="-1") CURTYPE=$P(TMP,"^",2)
39 ;RELEASE TYPE
40 S RELTYPE=""
41 S TMP=$$STATYPE^VAQCON1(POINTER,0)
42 S:($P(TMP,"^",1)'="-1") RELTYPE=$P(TMP,"^",2)
43 ;PATIENT NAME & SSN
44 S TMP=$G(^VAT(394.61,POINTER,"QRY"))
45 S NAME=$P(TMP,"^",1)
46 S SSN=$P(TMP,"^",2)
47 ;REQUEST DATE
48 S RQSTDATE=+$P($G(^VAT(394.61,POINTER,"RQST1")),"^",1)
49 ;AUTHORIZE DATE
50 S ATHRDATE=+$P($G(^VAT(394.61,POINTER,"ATHR1")),"^",1)
51 ;SEGMENTS
52 S SEGS=+$O(^VAT(394.61,POINTER,"SEG",0))
53 ;CHECK REQUIRED INFO
54 S:('NUMBER) FLAG=1
55 S:((CURTYPE="")&(RELTYPE="")) FLAG=1
56 S:((NAME="")&(SSN="")) FLAG=1
57 S:(('ATHRDATE)&('RQSTDATE)) FLAG=1
58 I ('RQSTDATE) D
59 .S TMP="^REQ^ACK^RES^"
60 .S X="^"_CURTYPE_"^"
61 .S:(TMP[X) FLAG=1
62 I ('ATHRDATE) D
63 .S TMP="^UNS^RES^"
64 .S X="^"_CURTYPE_"^"
65 .S:(TMP[X) FLAG=1
66 S:('SEGS) FLAG=1
67 ;CHECK REQUEST & AUTHORIZE DATES AGAINST PURGE DATE
68 S X1=PRGDATE
69 S X2=RQSTDATE
70 D ^%DTC
71 S X=+$G(X)
72 S RQSTOLD=$S(((X=0)!(X>0)):1,1:0)
73 S X1=PRGDATE
74 S X2=ATHRDATE
75 D ^%DTC
76 S X=+$G(X)
77 S ATHROLD=$S(((X=0)!(X>0)):1,1:0)
78 ;CHECK FOR ERROR DURING MESSAGE RECEIPT (CONSIDERD REQUIRED INFO)
79 I (CURTYPE="REC") D
80 .;NO REQUEST DATE BUT AUTHORIZE DATE OLDER THAN PURGE DATE
81 .I (('RQSTDATE)&(ATHROLD)) S FLAG=1 Q
82 .;NO AUTHORIZE DATE BUT REQUEST DATE OLDER THAN PURGE DATE
83 .I (('ATHRDATE)&(RQSTOLD)) S FLAG=1 Q
84 ;REQUIRED INFORMATION WAS NOT ALL PRESENT
85 I (FLAG) D Q TMP
86 .;DON'T FLAG FOR PURGING
87 .I ('SETPRGE) S TMP="2^0" Q
88 .;FLAG FOR PURGING
89 .S TMP=+$$FILEINFO^VAQFILE(394.61,POINTER,90,"YES")
90 .S TMP="2^"_$S(('TMP):"1",1:"-1")
91 ;REQUEST & AUTHORIZE DATES BOTH OLDER THAN PURGE DATE
92 Q:((RQSTOLD)&(ATHROLD)) 1
93 ;DON'T PURGE
94 Q 0
Note: See TracBrowser for help on using the repository browser.