source: FOIAVistA/tag/r/QUASAR-ACKQ/ACKQAG03.m@ 634

Last change on this file since 634 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1ACKQAG03 ;DALC/PJU - SEND AUDIOGRAM DATA TO DALC ;2/09/07
2 ;;3.0;QUASAR AUDIOMETRIC MODULE;**3,12,13**;11/01/02;Build 24
3 ; IA# 10018 [Supported] call to ^DIE to enter date sent & msg # into 509850.9
4 ; IA# 2701 [Supported] call to GETICN^MPIF001 - to get the ICN
5 ; IA# 10070 [Supported] call to EN1^XMD - add message text & send
6 ; IA# 2732 [Supported] call to CHKLINES^XMXSEC1 check message length
7 ; IA# 2240 [Supported] call to ENCRYP^XUSRB1 to encrypt SSN
8 ;
9START(RESULT,DFN,IEN,ACKQSTNU,ACKQUSNM,ACKQUSSR) ;
10 ;(DFN & IEN are required)
11 N ACKQER,ACKQERR,ACKQFA,ACKQHSSN,ACKQMSG,ACKQRMI,ACKQVT,SSN,ST,ICN
12 K ACKQARR S ACKQARR(0)=""
13 N XMTEXT,XMDUZ,XMRESTR,XMY,XMSUB
14 ;check for existence and get
15 S ACKQFA=$$ACKEXIST^ACKQAG05()
16 I 'ACKQFA S ACKQER=$$ERRTEXT(1) G END
17 S ACKQRMI=$$DFNIN^ACKQAG05(DFN)
18 I 'ACKQRMI S ACKQER=$$ERRTEXT(2) G END
19 I $G(IEN),(ACKQRMI'=IEN),'$D(^ACK(509850.9,IEN,0)) D G END
20 .S ACKQER=$$ERRTEXT(8)
21 S ST=$G(^ACK(509850.9,IEN,0))
22 I $G(IEN),$P(ST,U,2)'=DFN S ACKQER=$$ERRTEXT(9) G END
23 I $G(IEN),(ACKQRMI'=IEN) S ACKQRMI=IEN
24 ;create stub and address to S.RMROES3@DDC.VA.GOV
25 S (ACKQMSG,XMZ)=$$NEWMSG^ACKQAG05()
26 D EN^ACKQAG04(.ACKQARR,ACKQRMI,DFN) ;load data into array
27C S SSN=$P($G(ACKQARR(1)),U,4)
28 S ACKQHSSN=$$ENCRYP^XUSRB1(SSN)
29 S $P(ACKQARR(1),U,4)=ACKQHSSN ;send encrypted SSN
30 S ACKQVT=$P($G(ACKQARR(1)),U,11),ACKQVT=$E(ACKQVT,1,25) ;DFN type
31 S X="MPIF001" X ^%ZOSF("TEST")
32 I S ICN=$$GETICN^MPIF001(DFN),ICN=$E(ICN,1,10)
33 E S ICN=""
34 S I=$O(ACKQARR("A"),-1),I=I+1 ;ADD AFTER LAST SUBSCRIPT
35 S ACKQARR(I)="DDCINFO"_U_$G(ACKQSTNU)_U_$G(ACKQUSNM)_U_$G(ACKQUSSR)_U
36 S ACKQARR(I)=ACKQARR(I)_$G(ACKQRMI)_U_$G(ACKQHSSN)_U_U_$G(ACKQVT)_U
37 S ACKQARR(I)=ACKQARR(I)_$G(ICN)_U_$P(^ACK(509850.9,IEN,0),U,7) ;7/27/05
38 S XMTEXT="ACKQARR(",XMDUZ=DUZ,XQDATE=DT,XMSUB="AUDIOGRAM DATA"
39 D CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
40 I $D(XMRESTR("NONET")) D G END
41 .S ACKQER="Message too long for network. Limit "_XMRESTR("NONET")
42 D EN1^XMD ;add text and send
43 ;notify user with tracking details
44 ;S XMSUB="AUDIOGRAM DATA SENT"
45 ;S XMY(DUZ)="",XMDUZ="AUDIOGRAM PKG"
46 ;D XMZ^XMA2 ;gets XMZ
47 ;K ACKQARR
48 ;S ACKQARR(1)="Message sent to DDC is number: "_ACKQMSG
49 ;S ACKQARR(2)="Sent on: "_$$FMTE^XLFDT(DT)_" for patient:"_$P($G(^DPT(DFN,0)),U,1)
50 ;S ACKQARR(3)="Data sent is from AUDIOMETRIC EXAM file entry number: "_ACKQRMI
51 ;S XMTEXT="ACKQARR("
52 ;D EN1^XMD ;add text and send
53 ;put the date sent to DALC and the msg number into the Audiogram Data file
54 S DIE="^ACK(509850.9,",DA=ACKQRMI
55 I $P($G(^ACK(509850.9,ACKQRMI,0)),U,12) D ;already sent 1 time
56 .S DR=".15////"_DT_";.13////"_ACKQMSG_";.16////"_DUZ
57 E S DR=".12////"_DT_";.13////"_ACKQMSG
58 D ^DIE K DIE,DR,DA
59END D:$G(ACKQER) WRITEER K ACKQARR,I
60 ;XMMG is the failure msg if there is one
61 S RESULT=$G(XMZ)_U_$G(ACKQMSG)_U_$G(ACKQER)_U_$G(XMMG)
62 Q
63ERRTEXT(ACKQERR) ;error msg's, input error #
64 N ACKQER1 ;ERROR TEXT
65 S ACKQER1=$P($T(@(ACKQERR_"^ACKQAG03")),";",3) G ENDE
661 ;;THE AUDIOMETRIC DATA FILE CANNOT BE ACCESSED
672 ;;THERE IS NOT A VALID ENTRY FOR THIS PATIENT
683 ;;THE MESSAGE COULD NOT BE SET UP
694 ;;THE ADDRESS COULD NOT BE SET UP
705 ;;THERE HAS BEEN AN ERROR IN COLLECTING THE AUDIOMETRIC DATA
716 ;;ONE OF THE MESSAGE LINES WAS TOO LONG
727 ;;AN ERROR OCCURRED WHILE PLACING THE DATA INTO THE TRANSMISSION
738 ;;THE ENTRY FOUND IS NOT THE SAME ENTRY THAT IS BEING EDITED
749 ;;THERE IS A CONFLICT BETWEEN THE PATIENT AND THE FILE ENTRY
75 ;;
76ENDE Q ACKQER1
77 ;
78WRITEER ;W !!,"*****",ACKQER,"*****" ;for testing
79 ;S:$L($G(XMMG)) ACKQER="MSG FAILURE"
80 S ACKQER="*****"_ACKQER_"*****"
81 Q
Note: See TracBrowser for help on using the repository browser.