[613] | 1 | ACKQAG05 ;DALC/PJU - UTILITY FOR TRANSMISSION ;02/09/07
|
---|
| 2 | ;;3.0;QUASAR AUDIOMETRIC MODULE;**3,12,13**;11/01/02;Build 24
|
---|
| 3 | ;;ALSO CALLED FROM ACKQAG03
|
---|
| 4 | ; IA# 10103 [Supported] call to FMTE^XLFDT - change date
|
---|
| 5 | ; IA# 10066 [Supported] call to XMZ^XMA2 - new message stub
|
---|
| 6 | ; IA# 2701 [Supported] call to GETICN^MPIF001 - get ICN
|
---|
| 7 | ; IA# 10070 [Supported] call to EN1^XMD - add message text & send
|
---|
| 8 | ; IA# 2732 [Supported] call to CHKLINES^XMXSEC1 - check message length
|
---|
| 9 | ; IA# 2240 [Supported] call to ENCRYP^XUSRB1 - encrypt SSN
|
---|
| 10 | ACKEXIST() ;returns 1 if 509850.9 exists, else 0
|
---|
| 11 | N ACKQANS
|
---|
| 12 | I $D(^ACK(509850.9)),$O(^ACK(509850.9,0)) S ACKQANS=1
|
---|
| 13 | E S ACKQANS=0
|
---|
| 14 | ENDA Q ACKQANS
|
---|
| 15 | ;
|
---|
| 16 | DFNIN(DFN) ;input DFN of patient
|
---|
| 17 | ;return last entry in 509850.9 for DFN or 0 if none
|
---|
| 18 | N ACKQANS,ACKQI,ACKQL
|
---|
| 19 | S ACKQANS=0
|
---|
| 20 | I $D(^ACK(509850.9,"DFN",DFN)) D
|
---|
| 21 | .S ACKQL="A"
|
---|
| 22 | .S ACKQL=$O(^ACK(509850.9,"DFN",DFN,ACKQL),-1) Q:'ACKQL ;last date
|
---|
| 23 | .S ACKQI=0
|
---|
| 24 | .S ACKQI=$O(^ACK(509850.9,"DFN",DFN,ACKQL,ACKQI)) Q:'ACKQI ;entry
|
---|
| 25 | .I ACKQI>0 I $G(^ACK(509850.9,ACKQI,0))'="" S ACKQANS=ACKQI
|
---|
| 26 | ENDD Q ACKQANS
|
---|
| 27 | ;
|
---|
| 28 | NEWMSG() ;return entry in ^XMB(3.9
|
---|
| 29 | ; requires DUZ, sets up XMDUZ, XMSUB
|
---|
| 30 | ;outputs XMZ
|
---|
| 31 | S XMSUB="AUDIOGRAM DATA TRANSMISSION",XMDUZ=DUZ
|
---|
| 32 | S XMY("S.RMROES3@DDC.VA.GOV")=""
|
---|
| 33 | ;S XMY("S.RMROES3@DDCTRN.VA.GOV")="" ;for testing
|
---|
| 34 | D XMZ^XMA2 ;returns XMZ
|
---|
| 35 | Q XMZ
|
---|
| 36 | ;
|
---|
| 37 | DFNCT(RESULT,DFN) ;Return number of entries in 509850.9 file
|
---|
| 38 | ;outputs a number based on the DFN2 xref on DFN only
|
---|
| 39 | ;Called by RPC ACKQAUD4
|
---|
| 40 | N CT,I S (RESULT,CT,I)=0
|
---|
| 41 | ;G:'$D(^ACK(509850.9,"DFN2",DFN)) ENDC
|
---|
| 42 | ;F S I=$O(^ACK(509850.9,"DFN2",DFN,I)) Q:'I S CT=CT+1
|
---|
| 43 | ;S RESULT=CT
|
---|
| 44 | S RESULT(0)=CT_U_$P($G(^DPT(DFN,0)),U,1)
|
---|
| 45 | F S I=$O(^ACK(509850.9,"DFN2",DFN,I)) Q:'I D
|
---|
| 46 | .S CT=CT+1
|
---|
| 47 | .S RESULT(CT)=I,$P(RESULT(0),U,1)=CT
|
---|
| 48 | ENDC Q RESULT
|
---|
| 49 | ;
|
---|
| 50 | ;STARTD(RESULT,DFN,IEN,RMUSER)
|
---|
| 51 | STARTD(RESULT,DFN,IEN,ACKQSTNU,ACKQUSNM,ACKQUSSR) ;
|
---|
| 52 | ;Deletion message for RPC ACKQROESD (DFN & IEN are required)
|
---|
| 53 | ;N ACKQER,ACKQERR,ACKQFA,ACKQHSSN,ACKQMSG,DFNNAME,SSN,ST
|
---|
| 54 | N ACKQER,ACKQERR,ACKQFA,ACKQHSSN,ACKQMSG,ACKQRMI,ACKQVT,SSN,ST,ICN
|
---|
| 55 | K ACKQARR S ACKQARR(0)="",ACKQMSG="",XMZ="",ACKQER="",XMMG=""
|
---|
| 56 | N XMTEXT,XMDUZ,XMRESTR,XMY,XMSUB
|
---|
| 57 | ;check for existance and get entry
|
---|
| 58 | S ACKQFA=$$ACKEXIST() ;ck if file exist
|
---|
| 59 | I 'ACKQFA S ACKQER=$$ERRTEXT(1) G ENDS ;file not exist
|
---|
| 60 | I $G(IEN),$D(^ACK(509850.9,IEN,0)) D G ENDS ;local IEN not deleted
|
---|
| 61 | .S ACKQER=$$ERRTEXT(10)
|
---|
| 62 | S ACKQRMI=IEN ;10/5/05
|
---|
| 63 | ;create stub and address to S.RMROES3@DDC.VA.GOV
|
---|
| 64 | S (ACKQMSG,XMZ)=$$NEWMSG() ;returns XMZ addressed to S.RMROES3@DDC.VA.GOV
|
---|
| 65 | ;get data into array ACKQARR
|
---|
| 66 | ;ACKQARR(1)=BGN^IEN^DFNNAME^DFNssn^err^bd^tester^Signdt^ex dt^vet^type^age^tt^cl#^retran dt^"D"
|
---|
| 67 | S DFNNAME=$P($G(^DPT(DFN,0)),U,1)
|
---|
| 68 | S SSN=$P($G(^DPT(DFN,0)),U,9)
|
---|
| 69 | S ACKQHSSN=$$ENCRYP^XUSRB1(SSN)
|
---|
| 70 | S ACKQARR(1)="BGN^"_ACKQRMI_"^"_DFNNAME_"^"_ACKQHSSN_"^^^^^^^^^^^" ;send encrypted SSN
|
---|
| 71 | S ACKQARR(1)=ACKQARR(1)_DT_"^"_"D" ;tran date & delete flag
|
---|
| 72 | S X="MPIF001" X ^%ZOSF("TEST")
|
---|
| 73 | I S ICN=$$GETICN^MPIF001(DFN),ICN=$E(ICN,1,10)
|
---|
| 74 | E S ICN=""
|
---|
| 75 | S ACKQARR(2)="DDCINFO"_U_$G(ACKQSTNU)_U_$G(ACKQUSNM)_U_$G(ACKQUSSR)_U
|
---|
| 76 | S ACKQARR(2)=ACKQARR(2)_$G(ACKQRMI)_U_$G(ACKQHSSN)_U_U_U_$G(ICN)
|
---|
| 77 | S XMTEXT="ACKQARR(",XMDUZ=DUZ,XQDATE=DT,XMSUB="AUIDOGRAM DATA TRANSMISSION"
|
---|
| 78 | D CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
|
---|
| 79 | I $D(XMRESTR("NONET")) D G ENDS
|
---|
| 80 | .S ACKQER="Message too long for network. Limit "_XMRESTR("NONET")
|
---|
| 81 | D EN1^XMD ;add text and send
|
---|
| 82 | ;notify user
|
---|
| 83 | S XMSUB="AUDIOGRAM DELETION SENT"
|
---|
| 84 | S XMY(DUZ)="",XMDUZ="AUDIOGRAM PKG"
|
---|
| 85 | D XMZ^XMA2 ;returns XMZ
|
---|
| 86 | K ACKQARR
|
---|
| 87 | S ACKQARR(1)="Deletion Message to DALC for "_DFNNAME_" is MSG number:"_ACKQMSG
|
---|
| 88 | S ACKQARR(2)="Sent on: "_$$FMTE^XLFDT(DT)
|
---|
| 89 | S ACKQARR(3)="AUDIOMETRIC EXAM file entry number: "_ACKQRMI
|
---|
| 90 | S XMTEXT="ACKQARR(",XMSUB="AUDIOGRAM DELETION"
|
---|
| 91 | D EN1^XMD ;add text and send
|
---|
| 92 | ENDS D:$L($G(ACKQER)) WRITEER K ACKQARR,I
|
---|
| 93 | ;XMMG is the failure msg if there is one
|
---|
| 94 | S RESULT=$G(XMZ)_U_$G(ACKQMSG)_U_$G(ACKQER)_U_$G(XMMG)
|
---|
| 95 | Q
|
---|
| 96 | ;
|
---|
| 97 | ERRTEXT(ACKQERR) ;error msg's, input error #
|
---|
| 98 | N ACKQER1 ;ERROR TEXT
|
---|
| 99 | S ACKQER1=$P($T(@(ACKQERR_"^ACKQAG05")),";",3) G ENDE
|
---|
| 100 | 1 ;;THE AUDIOMETRIC DATA FILE CANNOT BE ACCESSED
|
---|
| 101 | 2 ;;THERE IS NOT A VALID ENTRY FOR THIS PATIENT
|
---|
| 102 | 3 ;;THE MESSAGE COULD NOT BE SET UP
|
---|
| 103 | 4 ;;THE ADDRESS COULD NOT BE SET UP
|
---|
| 104 | 5 ;;THERE HAS BEEN AN ERROR IN COLLECTING THE AUDIOMETRIC DATA
|
---|
| 105 | 6 ;;ONE OF THE MESSAGE LINES WAS TOO LONG
|
---|
| 106 | 7 ;;AN ERROR OCCURRED WHILE PLACING THE DATA INTO THE TRANSMISSION
|
---|
| 107 | 8 ;;THE ENTRY FOUND IS NOT THE SAME ENTRY THAT IS BEING EDITED
|
---|
| 108 | 9 ;;THERE IS A CONFLICT BETWEEN THE PATIENT AND THE FILE ENTRY
|
---|
| 109 | 10 ;;THE RECORD SELECTED HAS NOT BEEN LOCALLY DELETED
|
---|
| 110 | ENDE Q ACKQER1
|
---|
| 111 | ;
|
---|
| 112 | WRITEER ;W !!,"*****",ACKQER,"*****" ;for testing
|
---|
| 113 | ;S:$L($G(XMMG)) ACKQER="MSG FAILURE"
|
---|
| 114 | S ACKQER="*****"_ACKQER_"*****"
|
---|
| 115 | Q
|
---|