- 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 23, 2025@18:46:06 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
