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

VAQUTL97.m

Go to the documentation of this file.
  1. VAQUTL97 ;ALB/JFP,JRP - PDX Patient Lookup ;24-JAN-93
  1. ;;1.5;PATIENT DATA EXCHANGE;**2,9,29,35**;NOV 17, 1993
  1. ;
  1. GETDFN(PATIENT,TASK) ;-- Return DFN of patient
  1. ; -- This will return the same information that DIC returns in Y
  1. N DIC,X,Y,RESULT,USRABORT
  1. S USRABORT=-1
  1. S:'$D(PATIENT) PATIENT=""
  1. S:'$D(TASK) TASK=0
  1. ; -- User interface
  1. S DIC(0)="M"
  1. I (PATIENT="")&('TASK) S DIC(0)=DIC(0)_"A"
  1. I (PATIENT="")&(TASK) S RESULT=USRABORT Q RESULT
  1. S:TASK DIC(0)=DIC(0)_"XZ"
  1. S:'TASK DIC(0)=DIC(0)_"EQZ"
  1. S X=PATIENT
  1. S DIC="^DPT("
  1. ; -- Prevent sensitive record bulletin if called in TASK mode
  1. S:(TASK) DGSENFLG=""
  1. D ^DIC
  1. K DGSENFLG
  1. ; -- User aborted process
  1. Q:$D(DTOUT) USRABORT
  1. Q:$D(DUOUT) USRABORT
  1. Q Y
  1. ;
  1. GETSEN(DFN) ; -- Returns code for sensitive patient or not
  1. ; INPUT: DFN = Dictionary file number
  1. ; OUTPUT: 1 = Sensitive patient
  1. ; 0 = Non sensitive
  1. ; -1 = Bad input
  1. ;
  1. Q:'$D(DFN) -1
  1. Q:DFN="" -1
  1. Q:DFN=0 -1
  1. Q:'$D(^DGSL(38.1,DFN,0)) -0 ; -- not sensitive patient
  1. Q $P($G(^DGSL(38.1,DFN,0)),U,2) ; -- 1 SENSITIVE, 0 NON-SENSITIVE
  1. ;
  1. EXPTRN(TRANDA) ; -- Determines if any entry in the transactions file is
  1. ; marked for purge or exceed the life days.
  1. ; Also checks to make sure that requesting domain is
  1. ; not closed. If it is, it marks the transaction file
  1. ; entry for purging.
  1. ; INPUT : TRANDA DA TO TRANSACTION RECORD
  1. ; OUTOUT: -1 error in data
  1. ; 0 not expired
  1. ; 1 expired
  1. ;
  1. N X,LDAY,PURGE
  1. S PURGE=$P($G(^VAT(394.61,TRANDA,"PRG")),U,1)
  1. I PURGE=1 Q 1 ; -- purge flag set
  1. ;
  1. S X1=$$NOW^VAQUTL99(1,1) ; -- Current date
  1. S X2=$P($G(^VAT(394.61,TRANDA,"ATHR1")),U,1)
  1. I X2="" S X2=$P($G(^VAT(394.61,TRANDA,"RQST1")),U,1)
  1. S X2=$P(X2,".",1)
  1. I X2="" Q -1 ; -- error in data
  1. ;
  1. S LDAY=$P($G(^VAT(394.81,1,"LIFE")),U,1)
  1. I LDAY="" Q 0 ; -- no life days set
  1. ;
  1. D ^%DTC
  1. I X>LDAY Q 1 ; -- Expired
  1. Q 0
  1. CLOSDOM(TRANDA,DOMAIN) ; Function, given domain, returns whether
  1. ; the domain is closed or not. (1=closed; 0=not closed)
  1. ; If the domain is closed, then the transaction is marked for purging.
  1. Q:'$$CLOSED(DOMAIN) 0
  1. D SETPURGE(TRANDA)
  1. Q 1
  1. CLOSTRAN(TRANDA,NODE) ; Function, given transaction number, returns whether
  1. ; the domain is closed or not. (1=closed; 0=not closed)
  1. ; If NODE="RQST2", we are checking the domain that sent the request.
  1. ; If NODE="ATHR2", we are checking the domain to which we are sending
  1. ; the request. If the domain is closed, then the transaction is marked
  1. ; for purging.
  1. Q:'$$CLOSED($P($G(^VAT(394.61,TRANDA,NODE)),U,2)) 0
  1. D SETPURGE(TRANDA)
  1. Q 1
  1. CLOSED(DOMAIN) ; Function, given domain name, returns whether the domain
  1. ; is closed or not. 1=closed; 0=not closed
  1. N VIEN
  1. S VIEN=$$FIND1^DIC(4.2,"","MQX",DOMAIN,"B^C") Q:'VIEN 0
  1. Q $P($G(^DIC(4.2,VIEN,0)),U,2)["C"
  1. SETPURGE(TRANDA) ;
  1. N VFDA
  1. S VFDA(394.61,TRANDA_",",90)=1 ; set purge flag
  1. D FILE^DIE("","VFDA")
  1. Q
  1. ;
  1. GETINST(DOMAIN) ;-- Return name of institution for domain
  1. ;
  1. ; INPUT: DOMAIN -
  1. ; OUTPUT: NULL - ERROR
  1. ; INSTITUTION - SUCCESS
  1. ;
  1. N DOMNO,INSTDA,STNO,INST
  1. ;
  1. ;W !,"Domain = ",DOMAIN
  1. Q:'$D(DOMAIN) ""
  1. ;
  1. S DOMNO=+$$FIND1^DIC(4.2,"","BMX",DOMAIN,"B^C","","ERROR")
  1. Q:DOMNO=0 ""
  1. S INSTDA=$P($G(^DIC(4.2,DOMNO,0)),U,13) Q:INSTDA="" ""
  1. S STNO="",STNO=$O(^DIC(4,"D",INSTDA,"")) Q:STNO="" ""
  1. S INST=$P($G(^DIC(4,STNO,0)),U,1)
  1. Q:INST="" ""
  1. Q INST
  1. ;