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