source: FOIAVistA/tag/r/QUASAR-ACKQ/ACKQAG05.m@ 897

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1ACKQAG05 ;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
10ACKEXIST() ;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
14ENDA Q ACKQANS
15 ;
16DFNIN(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
26ENDD Q ACKQANS
27 ;
28NEWMSG() ;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 ;
37DFNCT(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
48ENDC Q RESULT
49 ;
50 ;STARTD(RESULT,DFN,IEN,RMUSER)
51STARTD(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
92ENDS 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 ;
97ERRTEXT(ACKQERR) ;error msg's, input error #
98 N ACKQER1 ;ERROR TEXT
99 S ACKQER1=$P($T(@(ACKQERR_"^ACKQAG05")),";",3) G ENDE
1001 ;;THE AUDIOMETRIC DATA FILE CANNOT BE ACCESSED
1012 ;;THERE IS NOT A VALID ENTRY FOR THIS PATIENT
1023 ;;THE MESSAGE COULD NOT BE SET UP
1034 ;;THE ADDRESS COULD NOT BE SET UP
1045 ;;THERE HAS BEEN AN ERROR IN COLLECTING THE AUDIOMETRIC DATA
1056 ;;ONE OF THE MESSAGE LINES WAS TOO LONG
1067 ;;AN ERROR OCCURRED WHILE PLACING THE DATA INTO THE TRANSMISSION
1078 ;;THE ENTRY FOUND IS NOT THE SAME ENTRY THAT IS BEING EDITED
1089 ;;THERE IS A CONFLICT BETWEEN THE PATIENT AND THE FILE ENTRY
10910 ;;THE RECORD SELECTED HAS NOT BEEN LOCALLY DELETED
110ENDE Q ACKQER1
111 ;
112WRITEER ;W !!,"*****",ACKQER,"*****" ;for testing
113 ;S:$L($G(XMMG)) ACKQER="MSG FAILURE"
114 S ACKQER="*****"_ACKQER_"*****"
115 Q
Note: See TracBrowser for help on using the repository browser.