PPPFMX2 ;ALB/JP - FILEMAN UTILITIES FOR PPP;10-AUG-93
 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**1**;APR 7,1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
PDXTRIG(TRANPTR,MODE) ;SET/KILL 'LOGIC' FOR PDX TRIGGER
 ;Input : TRANPTR - Pointer to VAQ - TRANSACTION file
 ;        MODE - Which 'logic' to use (SET or KILL)
 ;          1 = SET (default)
 ;          0 = KILL
 N SSN,FACILNO,DOMAIN,DATE,STATUS,FFPTR,TMP,STATPTR,NODE,SEGPTR,HASMPL
 ; -- CHECK INPUT
 Q:('$G(TRANPTR))
 Q:('$D(^VAT(394.61,TRANPTR)))
 S MODE=$G(MODE)
 S MODE=$S((MODE=""):1,(MODE=0):0,1:1)
 ; -- GET CURRENT STATUS OF TRANSACTION (POINTER AND VALUE)
 S TMP=$G(^VAT(394.61,TRANPTR,0))
 S STATPTR=+$P(TMP,"^",2)
 Q:('STATPTR)
 S STATUS=$P($$GETPDXST^PPPGET7(STATPTR),"^",1)
 ; -- ONLY ACT ON RESULTS TO A REQUEST AND UNSOLICITED PDXs
 S TMP="^VAQ-AMBIG^VAQ-NTFND^VAQ-REJ^VAQ-RSLT^VAQ-UNSOL^"
 Q:(TMP'[("^"_STATUS_"^"))
 ; -- DETERMINE IF TRANSACTION HAS SEGMENT 'PDX*MPL' (MED PROFILE LONG)
 S SEGPTR=+$O(^VAT(394.71,"C","PDX*MPL",""))
 Q:('SEGPTR)
 S HASMPL=+$O(^VAT(394.61,TRANPTR,"SEG","B",SEGPTR,""))
 ; -- GET DATE
 S TMP=$G(^VAT(394.61,TRANPTR,"ATHR1"))
 S DATE=+$P(TMP,"^",1)
 Q:(('DATE)&(MODE))
 ; -- GET REMOTE FACILITY NUMBER
 S TMP=$G(^VAT(394.61,TRANPTR,"ATHR2"))
 S DOMAIN=$P(TMP,"^",2)
 Q:(DOMAIN="")
 S FACILNO=+$O(^PPP(1020.8,"C",DOMAIN,""))
 Q:('FACILNO)
 ; -- GET PATIENT'S SSN
 S SSN=$P($G(^VAT(394.61,TRANPTR,"QRY")),"^",2)
 Q:(SSN="")
 ; -- GET POINTER TO PATIENT FILE
 S PATPTR=+$O(^DPT("SSN",SSN,""))
 Q:('PATPTR)
 ; -- Check for FFX entry or creates new one, on set logic
 I ($D(^PPP(1020.2,"AC",PATPTR,DOMAIN))=0)&(MODE=1) D  QUIT
 .S FFPTR=$$PDXFFX^PPPPDX3(SSN,DOMAIN)
 .D SETKILL
 ; -- GET POINTER TO FOREIGN FACILITY FILE
 S FFPTR=""
 F  S FFPTR=$O(^PPP(1020.2,"AC",PATPTR,DOMAIN,FFPTR)) Q:FFPTR=""  D SETKILL
 Q
SETKILL ; -- UPDATES PPP ENTRY WITH PDX POINTER or deletes it
 ; - Get node from FOREIGN FACILITY XREF File
 Q:(FFPTR<0)
 S NODE=$G(^PPP(1020.2,FFPTR,1))
 ; -- SET 'LOGIC'
SET I (MODE) D
 .; - Don't store if transaction does NOT contain segment 'PDX*MPL'
 .Q:('HASMPL)
 .; - STORE POINTER TO PDX TRANSACTION FILE
 .S $P(NODE,"^",1)=TRANPTR
 .; - STORE DATE OF TRANSACTION
 .S $P(NODE,"^",2)=DATE
 .; - STORE STATUS OF TRANSACTION
 .S $P(NODE,"^",3)=STATPTR
 ; -- KILL 'LOGIC'
KILL I ('MODE) D
 .; - ONLY DELETE IF SAME TRANSACTION
 .Q:((+$P(NODE,"^",1))'=TRANPTR)
 .; - DELETE POINTER TO PDX TRANSACTION FILE
 .S $P(NODE,"^",1)=""
 .S $P(NODE,"^",2)=""
 .S $P(NODE,"^",3)=""
 ; -- SAVE NODE FROM FOREIGN FACILITY XREF FILE
 S ^PPP(1020.2,FFPTR,1)=NODE
 Q