source: FOIAVistA/trunk/r/QUASAR-ACKQ/ACKQAG05.m@ 1354

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
 N ACKQANS
 I $D(^ACK(509850.9)),$O(^ACK(509850.9,0)) S ACKQANS=1
 E  S ACKQANS=0
ENDA Q ACKQANS
 ;
DFNIN(DFN)      ;input DFN of patient
 ;return last entry in 509850.9 for DFN or 0 if none
 N ACKQANS,ACKQI,ACKQL
 S ACKQANS=0
 I $D(^ACK(509850.9,"DFN",DFN)) D
 .S ACKQL="A"
 .S ACKQL=$O(^ACK(509850.9,"DFN",DFN,ACKQL),-1) Q:'ACKQL  ;last date
 .S ACKQI=0
 .S ACKQI=$O(^ACK(509850.9,"DFN",DFN,ACKQL,ACKQI)) Q:'ACKQI  ;entry
 .I ACKQI>0 I $G(^ACK(509850.9,ACKQI,0))'="" S ACKQANS=ACKQI
ENDD    Q ACKQANS
 ;
NEWMSG()  ;return entry in ^XMB(3.9
 ; requires DUZ, sets up XMDUZ, XMSUB
 ;outputs XMZ
 S XMSUB="AUDIOGRAM DATA TRANSMISSION",XMDUZ=DUZ
 S XMY("S.RMROES3@DDC.VA.GOV")=""
 ;S XMY("S.RMROES3@DDCTRN.VA.GOV")="" ;for testing
 D XMZ^XMA2 ;returns XMZ
 Q 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
 N CT,I S (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
 S RESULT(0)=CT_U_$P($G(^DPT(DFN,0)),U,1)
 F  S I=$O(^ACK(509850.9,"DFN2",DFN,I)) Q:'I  D
 .S CT=CT+1
 .S RESULT(CT)=I,$P(RESULT(0),U,1)=CT
ENDC Q 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
 N ACKQER,ACKQERR,ACKQFA,ACKQHSSN,ACKQMSG,ACKQRMI,ACKQVT,SSN,ST,ICN
 K ACKQARR S ACKQARR(0)="",ACKQMSG="",XMZ="",ACKQER="",XMMG=""
 N XMTEXT,XMDUZ,XMRESTR,XMY,XMSUB
 ;check for existance and get entry
 S ACKQFA=$$ACKEXIST() ;ck if file exist
 I 'ACKQFA S ACKQER=$$ERRTEXT(1) G ENDS ;file not exist
 I $G(IEN),$D(^ACK(509850.9,IEN,0)) D  G ENDS ;local IEN not deleted
 .S ACKQER=$$ERRTEXT(10)
 S ACKQRMI=IEN ;10/5/05
 ;create stub and address to S.RMROES3@DDC.VA.GOV
 S (ACKQMSG,XMZ)=$$NEWMSG() ;returns XMZ addressed to S.RMROES3@DDC.VA.GOV
 ;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"
 S DFNNAME=$P($G(^DPT(DFN,0)),U,1)
 S SSN=$P($G(^DPT(DFN,0)),U,9)
 S ACKQHSSN=$$ENCRYP^XUSRB1(SSN)
 S ACKQARR(1)="BGN^"_ACKQRMI_"^"_DFNNAME_"^"_ACKQHSSN_"^^^^^^^^^^^" ;send encrypted SSN
 S ACKQARR(1)=ACKQARR(1)_DT_"^"_"D"  ;tran date & delete flag
 S X="MPIF001" X ^%ZOSF("TEST")
 I  S ICN=$$GETICN^MPIF001(DFN),ICN=$E(ICN,1,10)
 E  S ICN=""
 S ACKQARR(2)="DDCINFO"_U_$G(ACKQSTNU)_U_$G(ACKQUSNM)_U_$G(ACKQUSSR)_U
 S ACKQARR(2)=ACKQARR(2)_$G(ACKQRMI)_U_$G(ACKQHSSN)_U_U_U_$G(ICN)
 S XMTEXT="ACKQARR(",XMDUZ=DUZ,XQDATE=DT,XMSUB="AUIDOGRAM DATA TRANSMISSION"
 D CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
 I $D(XMRESTR("NONET")) D  G ENDS
 .S ACKQER="Message too long for network. Limit "_XMRESTR("NONET")
 D EN1^XMD ;add text and send
 ;notify user
 S XMSUB="AUDIOGRAM DELETION SENT"
 S XMY(DUZ)="",XMDUZ="AUDIOGRAM PKG"
 D XMZ^XMA2 ;returns XMZ
 K ACKQARR
 S ACKQARR(1)="Deletion Message to DALC for "_DFNNAME_" is MSG number:"_ACKQMSG
 S ACKQARR(2)="Sent on: "_$$FMTE^XLFDT(DT)
 S ACKQARR(3)="AUDIOMETRIC EXAM file entry number: "_ACKQRMI
 S XMTEXT="ACKQARR(",XMSUB="AUDIOGRAM DELETION"
 D EN1^XMD ;add text and send
ENDS D:$L($G(ACKQER)) WRITEER K ACKQARR,I
 ;XMMG is the failure msg if there is one
 S RESULT=$G(XMZ)_U_$G(ACKQMSG)_U_$G(ACKQER)_U_$G(XMMG)
 Q
 ;
ERRTEXT(ACKQERR) ;error msg's, input error #
 N ACKQER1 ;ERROR TEXT
 S ACKQER1=$P($T(@(ACKQERR_"^ACKQAG05")),";",3) G ENDE
1 ;;THE AUDIOMETRIC DATA FILE CANNOT BE ACCESSED
2 ;;THERE IS NOT A VALID ENTRY FOR THIS PATIENT
3 ;;THE MESSAGE COULD NOT BE SET UP
4 ;;THE ADDRESS COULD NOT BE SET UP
5 ;;THERE HAS BEEN AN ERROR IN COLLECTING THE AUDIOMETRIC DATA
6 ;;ONE OF THE MESSAGE LINES WAS TOO LONG
7   ;;AN ERROR OCCURRED WHILE PLACING THE DATA INTO THE TRANSMISSION
8 ;;THE ENTRY FOUND IS NOT THE SAME ENTRY THAT IS BEING EDITED
9 ;;THERE IS A CONFLICT BETWEEN THE PATIENT AND THE FILE ENTRY
10 ;;THE RECORD SELECTED HAS NOT BEEN LOCALLY DELETED
ENDE Q ACKQER1
 ;
WRITEER ;W !!,"*****",ACKQER,"*****" ;for testing
 ;S:$L($G(XMMG)) ACKQER="MSG FAILURE"
 S ACKQER="*****"_ACKQER_"*****"
 Q