Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQPUR11

VAQPUR11.m

Go to the documentation of this file. 
  1. VAQPUR11 ;ALB/JRP - PURGING;15JUL93
  1.  ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. PRGCHK(POINTER,PRGDATE,SETPRGE) ;CHECK TO SEE IF TRANSACTION SHOULD BE PURGE
  1.  ;INPUT  : POINTER - Pointer to transaction to check
  1.  ;         PRGDATE - Date purging will be based on (FileMan format)
  1.  ;         SETPRGE - Flag indicating if purge flag should be set
  1.  ;                   when required data is not present
  1.  ;                 If 0, don't set purge flag (default)
  1.  ;                 If 1, set purge flag
  1.  ;OUTPUT : 0 - Transaction does not require purging
  1.  ;         1 - Transaction does require purging
  1.  ;         2^0 - Required info for transaction was not present and
  1.  ;               purge flag was not set
  1.  ;         2^1 - Required info for transaction was not present and
  1.  ;               purge flag has been set
  1.  ;         2^-1 - Required info for transaction was not present and
  1.  ;               purge flag could not be set
  1.  ;         3 - Transaction was already flaged for purging
  1.  ;        -1 - Error determing if transaction should be purged
  1.  ;
  1.  ;CHECK INPUT
  1.  Q:('(+$G(POINTER))) -1
  1.  Q:('(+$G(PRGDATE))) -1
  1.  Q:('$D(^VAT(394.61,POINTER))) -1
  1.  S SETPRGE=+$G(SETPRGE)
  1.  ;DECLARE VARIABLES
  1.  N NUMBER,CURTYPE,RELTYPE,NAME,SSN,RQSTDATE
  1.  N ATHRDATE,SEGS,X1,X2,X,%Y,TMP,FLAG,RQSTOLD,ATHROLD
  1.  S FLAG=0
  1.  ;CHECK PURGE FLAG
  1.  Q:($D(^VAT(394.61,"PURGE",1,POINTER))) 3
  1.  ;GET REQUIRED INFORMATION
  1.  ;TRANSACTION NUMBER
  1.  S NUMBER=+$G(^VAT(394.61,POINTER,0))
  1.  ;CURRENT TYPE
  1.  S CURTYPE=""
  1.  S TMP=$$STATYPE^VAQCON1(POINTER,1)
  1.  S:($P(TMP,"^",1)'="-1") CURTYPE=$P(TMP,"^",2)
  1.  ;RELEASE TYPE
  1.  S RELTYPE=""
  1.  S TMP=$$STATYPE^VAQCON1(POINTER,0)
  1.  S:($P(TMP,"^",1)'="-1") RELTYPE=$P(TMP,"^",2)
  1.  ;PATIENT NAME & SSN
  1.  S TMP=$G(^VAT(394.61,POINTER,"QRY"))
  1.  S NAME=$P(TMP,"^",1)
  1.  S SSN=$P(TMP,"^",2)
  1.  ;REQUEST DATE
  1.  S RQSTDATE=+$P($G(^VAT(394.61,POINTER,"RQST1")),"^",1)
  1.  ;AUTHORIZE DATE
  1.  S ATHRDATE=+$P($G(^VAT(394.61,POINTER,"ATHR1")),"^",1)
  1.  ;SEGMENTS
  1.  S SEGS=+$O(^VAT(394.61,POINTER,"SEG",0))
  1.  ;CHECK REQUIRED INFO
  1.  S:('NUMBER) FLAG=1
  1.  S:((CURTYPE="")&(RELTYPE="")) FLAG=1
  1.  S:((NAME="")&(SSN="")) FLAG=1
  1.  S:(('ATHRDATE)&('RQSTDATE)) FLAG=1
  1.  I ('RQSTDATE) D
  1.  .S TMP="^REQ^ACK^RES^"
  1.  .S X="^"_CURTYPE_"^"
  1.  .S:(TMP[X) FLAG=1
  1.  I ('ATHRDATE) D
  1.  .S TMP="^UNS^RES^"
  1.  .S X="^"_CURTYPE_"^"
  1.  .S:(TMP[X) FLAG=1
  1.  S:('SEGS) FLAG=1
  1.  ;CHECK REQUEST & AUTHORIZE DATES AGAINST PURGE DATE
  1.  S X1=PRGDATE
  1.  S X2=RQSTDATE
  1.  D ^%DTC
  1.  S X=+$G(X)
  1.  S RQSTOLD=$S(((X=0)!(X>0)):1,1:0)
  1.  S X1=PRGDATE
  1.  S X2=ATHRDATE
  1.  D ^%DTC
  1.  S X=+$G(X)
  1.  S ATHROLD=$S(((X=0)!(X>0)):1,1:0)
  1.  ;CHECK FOR ERROR DURING MESSAGE RECEIPT (CONSIDERD REQUIRED INFO)
  1.  I (CURTYPE="REC") D
  1.  .;NO REQUEST DATE BUT AUTHORIZE DATE OLDER THAN PURGE DATE
  1.  .I (('RQSTDATE)&(ATHROLD)) S FLAG=1 Q
  1.  .;NO AUTHORIZE DATE BUT REQUEST DATE OLDER THAN PURGE DATE
  1.  .I (('ATHRDATE)&(RQSTOLD)) S FLAG=1 Q
  1.  ;REQUIRED INFORMATION WAS NOT ALL PRESENT
  1.  I (FLAG) D  Q TMP
  1.  .;DON'T FLAG FOR PURGING
  1.  .I ('SETPRGE) S TMP="2^0" Q
  1.  .;FLAG FOR PURGING
  1.  .S TMP=+$$FILEINFO^VAQFILE(394.61,POINTER,90,"YES")
  1.  .S TMP="2^"_$S(('TMP):"1",1:"-1")
  1.  ;REQUEST & AUTHORIZE DATES BOTH OLDER THAN PURGE DATE
  1.  Q:((RQSTOLD)&(ATHROLD)) 1
  1.  ;DON'T PURGE
  1.  Q 0