ACKQAG05        ;DALC/PJU - UTILITY FOR TRANSMISSION ;02/09/07
 ;;3.0;QUASAR AUDIOMETRIC MODULE;**3,12,13**;11/01/02;Build 24
    ;;ALSO CALLED FROM ACKQAG03
 ; IA# 10103 [Supported] call to FMTE^XLFDT - change date
 ; IA# 10066 [Supported] call to XMZ^XMA2 - new message stub
 ; IA# 2701  [Supported] call to GETICN^MPIF001 - get ICN
 ; IA# 10070 [Supported] call to EN1^XMD - add message text & send
 ; IA# 2732  [Supported] call to CHKLINES^XMXSEC1 - check message length
 ; IA# 2240  [Supported] call to ENCRYP^XUSRB1 - encrypt SSN
ACKEXIST()      ;returns 1 if 509850.9 exists, else 0
 
ACKQANS
 
I $D(^ACK(509850.9)),$O(^ACK(509850.9,0)) ACKQANS=1
 
E  S ACKQANS=0
ENDA ACKQANS
 
;
DFNIN(DFN)      ;input DFN of patient
 ;return last entry in 509850.9 for DFN or 0 if none
 
ACKQANS,ACKQI,ACKQL
 
ACKQANS=0
 
I $D(^ACK(509850.9,"DFN",DFN)) D
 
.ACKQL="A"
 
.ACKQL=$O(^ACK(509850.9,"DFN",DFN,ACKQL),-1) Q:'ACKQL  ;last date
 
.ACKQI=0
 .
ACKQI=$O(^ACK(509850.9,"DFN",DFN,ACKQL,ACKQI)) Q:'ACKQI  ;entry
 
.ACKQI>0 I $G(^ACK(509850.9,ACKQI,0))'="" ACKQANS=ACKQI
ENDD    ACKQANS
 
;
NEWMSG()  ;return entry in ^XMB(3.9
 ; requires DUZ, sets up XMDUZ, XMSUB
 ;outputs XMZ
 
XMSUB="AUDIOGRAM DATA TRANSMISSION",XMDUZ=DUZ
 
XMY("S.RMROES3@DDC.DOMAIN.EXT")=""
 ;S XMY("S.RMROES3@DDCTRN.DOMAIN.EXT")="" ;for testing
 
XMZ^XMA2 ;returns XMZ
 
XMZ
 
;
DFNCT(RESULT,DFN) ;Return number of entries in 509850.9 file
 ;outputs a number based on the DFN2 xref on DFN only
 ;Called by RPC ACKQAUD4
 
CT,(RESULT,CT,I)=0
 
;G:'$D(^ACK(509850.9,"DFN2",DFN)) ENDC
 ;F  S I=$O(^ACK(509850.9,"DFN2",DFN,I)) Q:'I  S CT=CT+1
 ;S RESULT=CT
 
RESULT(0)=CT_U_$P($G(^DPT(DFN,0)),U,1)
 
F  S I=$O(^ACK(509850.9,"DFN2",DFN,I)) Q:'I  D
 
.CT=CT+1
 .
RESULT(CT)=I,$P(RESULT(0),U,1)=CT
ENDC RESULT
 
;
 ;STARTD(RESULT,DFN,IEN,RMUSER)
STARTD(RESULT,DFN,IEN,ACKQSTNU,ACKQUSNM,ACKQUSSR) ;
 ;Deletion message for RPC ACKQROESD (DFN & IEN are required)
 ;N ACKQER,ACKQERR,ACKQFA,ACKQHSSN,ACKQMSG,DFNNAME,SSN,ST
 
ACKQER,ACKQERR,ACKQFA,ACKQHSSN,ACKQMSG,ACKQRMI,ACKQVT,SSN,ST,ICN
 
ACKQARR ACKQARR(0)="",ACKQMSG="",XMZ="",ACKQER="",XMMG=""
 
XMTEXT,XMDUZ,XMRESTR,XMY,XMSUB
 
;check for existance and get entry
 
ACKQFA=$$ACKEXIST() ;ck if file exist
 
'ACKQFA ACKQER=$$ERRTEXT(1) ENDS ;file not exist
 
I $G(IEN),$D(^ACK(509850.9,IEN,0)) D  G ENDS ;local IEN not deleted
 
.ACKQER=$$ERRTEXT(10)
 
ACKQRMI=IEN ;10/5/05
 ;create stub and address to S.RMROES3@DDC.DOMAIN.EXT
 
(ACKQMSG,XMZ)=$$NEWMSG() ;returns XMZ addressed to S.RMROES3@DDC.DOMAIN.EXT
 ;get data into array ACKQARR
 ;ACKQARR(1)=BGN^IEN^DFNNAME^DFNssn^err^bd^tester^Signdt^ex dt^vet^type^age^tt^cl#^retran dt^"D"
 
DFNNAME=$P($G(^DPT(DFN,0)),U,1)
 
SSN=$P($G(^DPT(DFN,0)),U,9)
 
ACKQHSSN=$$ENCRYP^XUSRB1(SSN)
 
ACKQARR(1)="BGN^"_ACKQRMI_"^"_DFNNAME_"^"_ACKQHSSN_"^^^^^^^^^^^" ;send encrypted SSN
 
ACKQARR(1)=ACKQARR(1)_DT_"^"_"D"  ;tran date & delete flag
 
X="MPIF001" ^%ZOSF("TEST")
 
I  S ICN=$$GETICN^MPIF001(DFN),ICN=$E(ICN,1,10)
 
E  S ICN=""
 
ACKQARR(2)="DDCINFO"_U_$G(ACKQSTNU)_U_$G(ACKQUSNM)_U_$G(ACKQUSSR)_U
 
ACKQARR(2)=ACKQARR(2)_$G(ACKQRMI)_U_$G(ACKQHSSN)_U_U_U_$G(ICN)
 
XMTEXT="ACKQARR(",XMDUZ=DUZ,XQDATE=DT,XMSUB="AUIDOGRAM DATA TRANSMISSION"
 
CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
 
I $D(XMRESTR("NONET")) D  G ENDS
 
.ACKQER="Message too long for network. Limit "_XMRESTR("NONET")
 
EN1^XMD ;add text and send
 ;notify user
 
XMSUB="AUDIOGRAM DELETION SENT"
 
XMY(DUZ)="",XMDUZ="AUDIOGRAM PKG"
 
XMZ^XMA2 ;returns XMZ
 
ACKQARR
 
ACKQARR(1)="Deletion Message to DALC for "_DFNNAME_" is MSG number:"_ACKQMSG
 
ACKQARR(2)="Sent on: "_$$FMTE^XLFDT(DT)
 
ACKQARR(3)="AUDIOMETRIC EXAM file entry number: "_ACKQRMI
 
XMTEXT="ACKQARR(",XMSUB="AUDIOGRAM DELETION"
 
EN1^XMD ;add text and send
ENDS D:$L($G(ACKQER)) WRITEER ACKQARR,I
 
;XMMG is the failure msg if there is one
 
RESULT=$G(XMZ)_U_$G(ACKQMSG)_U_$G(ACKQER)_U_$G(XMMG)
 
Q
 
;
ERRTEXT(ACKQERR) ;error msg's, input error #
 
ACKQER1 ;ERROR TEXT
 
ACKQER1=$P($T(@(ACKQERR_"^ACKQAG05")),";",3) ENDE
;;THE AUDIOMETRIC DATA FILE CANNOT BE ACCESSED
;;THERE IS NOT A VALID ENTRY FOR THIS PATIENT
;;THE MESSAGE COULD NOT BE SET UP
;;THE ADDRESS COULD NOT BE SET UP
;;THERE HAS BEEN AN ERROR IN COLLECTING THE AUDIOMETRIC DATA
;;ONE OF THE MESSAGE LINES WAS TOO LONG
7   ;;AN ERROR OCCURRED WHILE PLACING THE DATA INTO THE TRANSMISSION
;;THE ENTRY FOUND IS NOT THE SAME ENTRY THAT IS BEING EDITED
;;THERE IS A CONFLICT BETWEEN THE PATIENT AND THE FILE ENTRY
10 ;;THE RECORD SELECTED HAS NOT BEEN LOCALLY DELETED
ENDE ACKQER1
 
;
WRITEER ;W !!,"*****",ACKQER,"*****" ;for testing
 ;S:$L($G(XMMG)) ACKQER="MSG FAILURE"
 
ACKQER="*****"_ACKQER_"*****"
 
Q