ACKQAG03 ;DALC/PJU - SEND AUDIOGRAM DATA TO DALC ;2/09/07
;;3.0;QUASAR AUDIOMETRIC MODULE;**3,12,13**;11/01/02;Build 24
; IA# 10018 [Supported] call to ^DIE to enter date sent & msg # into 509850.9
; IA# 2701 [Supported] call to GETICN^MPIF001 - to get the 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 to encrypt SSN
;
START(RESULT,DFN,IEN,ACKQSTNU,ACKQUSNM,ACKQUSSR) ;
;(DFN & IEN are required)
N ACKQER,ACKQERR,ACKQFA,ACKQHSSN,ACKQMSG,ACKQRMI,ACKQVT,SSN,ST,ICN
K ACKQARR S ACKQARR(0)=""
N XMTEXT,XMDUZ,XMRESTR,XMY,XMSUB
;check for existence and get
S ACKQFA=$$ACKEXIST^ACKQAG05()
I 'ACKQFA S ACKQER=$$ERRTEXT(1) G END
S ACKQRMI=$$DFNIN^ACKQAG05(DFN)
I 'ACKQRMI S ACKQER=$$ERRTEXT(2) G END
I $G(IEN),(ACKQRMI'=IEN),'$D(^ACK(509850.9,IEN,0)) D G END
.S ACKQER=$$ERRTEXT(8)
S ST=$G(^ACK(509850.9,IEN,0))
I $G(IEN),$P(ST,U,2)'=DFN S ACKQER=$$ERRTEXT(9) G END
I $G(IEN),(ACKQRMI'=IEN) S ACKQRMI=IEN
;create stub and address to S.RMROES3@DDC.DOMAIN.EXT
S (ACKQMSG,XMZ)=$$NEWMSG^ACKQAG05()
D EN^ACKQAG04(.ACKQARR,ACKQRMI,DFN) ;load data into array
C S SSN=$P($G(ACKQARR(1)),U,4)
S ACKQHSSN=$$ENCRYP^XUSRB1(SSN)
S $P(ACKQARR(1),U,4)=ACKQHSSN ;send encrypted SSN
S ACKQVT=$P($G(ACKQARR(1)),U,11),ACKQVT=$E(ACKQVT,1,25) ;DFN type
S X="MPIF001" X ^%ZOSF("TEST")
I S ICN=$$GETICN^MPIF001(DFN),ICN=$E(ICN,1,10)
E S ICN=""
S I=$O(ACKQARR("A"),-1),I=I+1 ;ADD AFTER LAST SUBSCRIPT
S ACKQARR(I)="DDCINFO"_U_$G(ACKQSTNU)_U_$G(ACKQUSNM)_U_$G(ACKQUSSR)_U
S ACKQARR(I)=ACKQARR(I)_$G(ACKQRMI)_U_$G(ACKQHSSN)_U_U_$G(ACKQVT)_U
S ACKQARR(I)=ACKQARR(I)_$G(ICN)_U_$P(^ACK(509850.9,IEN,0),U,7) ;7/27/05
S XMTEXT="ACKQARR(",XMDUZ=DUZ,XQDATE=DT,XMSUB="AUDIOGRAM DATA"
D CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
I $D(XMRESTR("NONET")) D G END
.S ACKQER="Message too long for network. Limit "_XMRESTR("NONET")
D EN1^XMD ;add text and send
;notify user with tracking details
;S XMSUB="AUDIOGRAM DATA SENT"
;S XMY(DUZ)="",XMDUZ="AUDIOGRAM PKG"
;D XMZ^XMA2 ;gets XMZ
;K ACKQARR
;S ACKQARR(1)="Message sent to DDC is number: "_ACKQMSG
;S ACKQARR(2)="Sent on: "_$$FMTE^XLFDT(DT)_" for patient:"_$P($G(^DPT(DFN,0)),U,1)
;S ACKQARR(3)="Data sent is from AUDIOMETRIC EXAM file entry number: "_ACKQRMI
;S XMTEXT="ACKQARR("
;D EN1^XMD ;add text and send
;put the date sent to DALC and the msg number into the Audiogram Data file
S DIE="^ACK(509850.9,",DA=ACKQRMI
I $P($G(^ACK(509850.9,ACKQRMI,0)),U,12) D ;already sent 1 time
.S DR=".15////"_DT_";.13////"_ACKQMSG_";.16////"_DUZ
E S DR=".12////"_DT_";.13////"_ACKQMSG
D ^DIE K DIE,DR,DA
END D:$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_"^ACKQAG03")),";",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
;;
ENDE Q ACKQER1
;
WRITEER ;W !!,"*****",ACKQER,"*****" ;for testing
;S:$L($G(XMMG)) ACKQER="MSG FAILURE"
S ACKQER="*****"_ACKQER_"*****"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQAG03 3669 printed Apr 09, 2024@21:34:24 Page 2
ACKQAG03 ;DALC/PJU - SEND AUDIOGRAM DATA TO DALC ;2/09/07
+1 ;;3.0;QUASAR AUDIOMETRIC MODULE;**3,12,13**;11/01/02;Build 24
+2 ; IA# 10018 [Supported] call to ^DIE to enter date sent & msg # into 509850.9
+3 ; IA# 2701 [Supported] call to GETICN^MPIF001 - to get the ICN
+4 ; IA# 10070 [Supported] call to EN1^XMD - add message text & send
+5 ; IA# 2732 [Supported] call to CHKLINES^XMXSEC1 check message length
+6 ; IA# 2240 [Supported] call to ENCRYP^XUSRB1 to encrypt SSN
+7 ;
START(RESULT,DFN,IEN,ACKQSTNU,ACKQUSNM,ACKQUSSR) ;
+1 ;(DFN & IEN are required)
+2 NEW ACKQER,ACKQERR,ACKQFA,ACKQHSSN,ACKQMSG,ACKQRMI,ACKQVT,SSN,ST,ICN
+3 KILL ACKQARR
SET ACKQARR(0)=""
+4 NEW XMTEXT,XMDUZ,XMRESTR,XMY,XMSUB
+5 ;check for existence and get
+6 SET ACKQFA=$$ACKEXIST^ACKQAG05()
+7 IF 'ACKQFA
SET ACKQER=$$ERRTEXT(1)
GOTO END
+8 SET ACKQRMI=$$DFNIN^ACKQAG05(DFN)
+9 IF 'ACKQRMI
SET ACKQER=$$ERRTEXT(2)
GOTO END
+10 IF $GET(IEN)
IF (ACKQRMI'=IEN)
IF '$DATA(^ACK(509850.9,IEN,0))
Begin DoDot:1
+11 SET ACKQER=$$ERRTEXT(8)
End DoDot:1
GOTO END
+12 SET ST=$GET(^ACK(509850.9,IEN,0))
+13 IF $GET(IEN)
IF $PIECE(ST,U,2)'=DFN
SET ACKQER=$$ERRTEXT(9)
GOTO END
+14 IF $GET(IEN)
IF (ACKQRMI'=IEN)
SET ACKQRMI=IEN
+15 ;create stub and address to S.RMROES3@DDC.DOMAIN.EXT
+16 SET (ACKQMSG,XMZ)=$$NEWMSG^ACKQAG05()
+17 ;load data into array
DO EN^ACKQAG04(.ACKQARR,ACKQRMI,DFN)
C SET SSN=$PIECE($GET(ACKQARR(1)),U,4)
+1 SET ACKQHSSN=$$ENCRYP^XUSRB1(SSN)
+2 ;send encrypted SSN
SET $PIECE(ACKQARR(1),U,4)=ACKQHSSN
+3 ;DFN type
SET ACKQVT=$PIECE($GET(ACKQARR(1)),U,11)
SET ACKQVT=$EXTRACT(ACKQVT,1,25)
+4 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
+5 IF $TEST
SET ICN=$$GETICN^MPIF001(DFN)
SET ICN=$EXTRACT(ICN,1,10)
+6 IF '$TEST
SET ICN=""
+7 ;ADD AFTER LAST SUBSCRIPT
SET I=$ORDER(ACKQARR("A"),-1)
SET I=I+1
+8 SET ACKQARR(I)="DDCINFO"_U_$GET(ACKQSTNU)_U_$GET(ACKQUSNM)_U_$GET(ACKQUSSR)_U
+9 SET ACKQARR(I)=ACKQARR(I)_$GET(ACKQRMI)_U_$GET(ACKQHSSN)_U_U_$GET(ACKQVT)_U
+10 ;7/27/05
SET ACKQARR(I)=ACKQARR(I)_$GET(ICN)_U_$PIECE(^ACK(509850.9,IEN,0),U,7)
+11 SET XMTEXT="ACKQARR("
SET XMDUZ=DUZ
SET XQDATE=DT
SET XMSUB="AUDIOGRAM DATA"
+12 DO CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
+13 IF $DATA(XMRESTR("NONET"))
Begin DoDot:1
+14 SET ACKQER="Message too long for network. Limit "_XMRESTR("NONET")
End DoDot:1
GOTO END
+15 ;add text and send
DO EN1^XMD
+16 ;notify user with tracking details
+17 ;S XMSUB="AUDIOGRAM DATA SENT"
+18 ;S XMY(DUZ)="",XMDUZ="AUDIOGRAM PKG"
+19 ;D XMZ^XMA2 ;gets XMZ
+20 ;K ACKQARR
+21 ;S ACKQARR(1)="Message sent to DDC is number: "_ACKQMSG
+22 ;S ACKQARR(2)="Sent on: "_$$FMTE^XLFDT(DT)_" for patient:"_$P($G(^DPT(DFN,0)),U,1)
+23 ;S ACKQARR(3)="Data sent is from AUDIOMETRIC EXAM file entry number: "_ACKQRMI
+24 ;S XMTEXT="ACKQARR("
+25 ;D EN1^XMD ;add text and send
+26 ;put the date sent to DALC and the msg number into the Audiogram Data file
+27 SET DIE="^ACK(509850.9,"
SET DA=ACKQRMI
+28 ;already sent 1 time
IF $PIECE($GET(^ACK(509850.9,ACKQRMI,0)),U,12)
Begin DoDot:1
+29 SET DR=".15////"_DT_";.13////"_ACKQMSG_";.16////"_DUZ
End DoDot:1
+30 IF '$TEST
SET DR=".12////"_DT_";.13////"_ACKQMSG
+31 DO ^DIE
KILL DIE,DR,DA
END if $GET(ACKQER)
DO WRITEER
KILL ACKQARR,I
+1 ;XMMG is the failure msg if there is one
+2 SET RESULT=$GET(XMZ)_U_$GET(ACKQMSG)_U_$GET(ACKQER)_U_$GET(XMMG)
+3 QUIT
ERRTEXT(ACKQERR) ;error msg's, input error #
+1 ;ERROR TEXT
NEW ACKQER1
+2 SET ACKQER1=$PIECE($TEXT(@(ACKQERR_"^ACKQAG03")),";",3)
GOTO 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
+1 ;;
ENDE QUIT ACKQER1
+1 ;
WRITEER ;W !!,"*****",ACKQER,"*****" ;for testing
+1 ;S:$L($G(XMMG)) ACKQER="MSG FAILURE"
+2 SET ACKQER="*****"_ACKQER_"*****"
+3 QUIT
