APSPES3 ;IHS/MSC/PLS - SureScripts HL7 interface - con't;10-Sep-2013 09:40;PLS
;;7.0;IHS PHARMACY MODIFICATIONS;**1008,1011,1013,1016**;Sep 23, 2004;Build 74
; Send denial message
; Input: ORID - ^OR(100 IEN
; RXIEN - Prescription IEN
; OCC - Order Control Code (default to DF)
; MSGTXT - optional
; STA - Status (default to 3)
DENY(ORID,RXIEN,OCC,MSGTXT,STA) ;
N RR
S RR=$$VALUE^ORCSAVE2(+ORID,"SSRREQIEN")
Q:'RR
DENY1 N DATA,HLMSGIEN,HLMSTATE,ARY,SEG,ACT,HLECH,HLFS
N PARMS,ACK,ERR,I,FLG,LP,LOG,DNYC,DNYR,DFN,ACTUSR
S ORID=+$G(ORID)
S RXIEN=+$G(RXIEN)
S ACT=$$GET1^DIQ(9009033.91,RR,.08,"I")
S ACTUSR=$$GET1^DIQ(9009033.91,RR,.09,"I")
S DFN=$$GET1^DIQ(9009033.91,RR,1.2,"I")
;S OCC=$G(OCC,"DF")
S OCC=$S($G(OCC):OCC,ACT=3:"RP",ACT=4:"DF",1:"DF")
S HLMSGIEN=$$GET1^DIQ(9009033.91,RR,.05) ; Message ID
; TODO- Add logic to use the HL7 message text in the RR entry if HL7 message has been purged.
Q:'HLMSGIEN
S PARMS("ACK CODE")="AA"
S PARMS("MESSAGE TYPE")="RRE"
S PARMS("EVENT")="O26"
S PARMS("VERSION")=2.5
S PARMS("ACCEPT ACK TYPE")="AL"
I $L($G(MSGTXT)) D
.I $L($P(MSGTXT,"-",1)) S DNYC=$P(MSGTXT,"-",1),MSGTXT=$P(MSGTXT,"-",2)
.E S DNYC="AF"
E D
.S DNYR=$$VALUE^ORCSAVE2(+ORID,"SSDENYRSN")
.I $L(DNYR) D
..S DNYC=$P(DNYR,"-")
..S MSGTXT=$P(DNYR,"-",2)
.E S DNYC="AF"
S MSGTXT=$G(MSGTXT,"Have patient return to clinic.")
D PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
S HLFS=$G(DATA("HDR","FIELD SEPARATOR"))
S HLECH=HLMSTATE("HDR","ENCODING CHARACTERS")
I $$ACK^HLOAPI2(.HLMSTATE,.PARMS,.ACK,.ERR) D
.D SETACK
.I '$$SENDACK^HLOAPI2(.ACK,.ERR) D UPTRRACT(RR,$G(ERR,"There was a problem sending the HL7 message."))
E D UPTRRACT(RR,$G(ERR,"There was a problem generating the HL7 message."))
K FDA,ERR
S:+$$GET1^DIQ(9009033.91,RR,.08,"I")'=3 FDA(9009033.91,RR_",",.02)="@" ; Remove order ien
S FDA(9009033.91,RR_",",.03)=$S($G(STA):STA,+$$GET1^DIQ(9009033.91,RR,.08,"I")=3:5,1:3) ; Set status to processed-denied
S FDA(9009033.91,RR_",",.07)=$$NOW^XLFDT()
S FDA(9009033.91,RR_",",4)=$G(DNYC)_"-"_$G(MSGTXT)
I ACTUSR="" S FDA(9009033.91,RR_",",.09)=DUZ
D FILE^DIE(,"FDA","ERR")
; Get original order prescription IEN
I 'RXIEN D
.N SEGIEN,SEGORC
.D PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
.S SEGIEN=$$FSEGIEN^APSPES1(.DATA,"ORC")
.I SEGIEN D
..M SEGORC=DATA(SEGIEN)
..S RXIEN=$$GET^HLOPRS(.SEGORC,2,1)
; Update activity log
I RXIEN D
.N LOG,RET
.S LOG("REASON")="X"
.S LOG("RX REF")=0
.S ARY("TYPE")="U"
.S LOG("COM")="eRx denial response sent to "_$$PHMINFO^APSPES2(RXIEN)
.D UPTLOG^APSPFNC2(.RET,RXIEN,0,.LOG)
Q
SETACK ;Get original message to include in ack
N PRV,ACT,NM,LP,VAL,INST,MRN
D PREPARY^APSPES1(.DATA,"PID",.ARY)
;Get pt id
D:$G(DFN) SET(.ARY,$$HRCNF^BDGF2(DFN,+$G(DUZ(2))),3,1) ; Patient HRN
S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
D SET(.ARY,OCC,1) ; Order Control Code
D PREPARY^APSPES1(.DATA,"ORC",.ARY)
D SET(.ARY,OCC,1) ; Order Control Code
D SET(.ARY,$$HLDATE^HLFNC($$NOW^XLFDT()),9) ; Written Date/Time
D SET(.ARY,DNYC,16,1) ; Order Control Code Reason Identifier
D SET(.ARY,$E(MSGTXT,1,70),16,2) ; Order Control Code Reason Text
D SET(.ARY,"NCPDP1131",16,3) ; Order Control Code Reason System
D SET(.ARY,$$GET1^DIQ(4,+$G(DUZ(2)),.01),21) ; Institution Name
S PRV=$$GET1^DIQ(9009033.91,RR,1.3,"I")
S ACT=$$GET1^DIQ(9009033.91,RR,.09,"I")
I +PRV'=+ACT D
.D SET(.ARY,ACT,19,1)
.S NM=$$HLNAME^HLFNC($$GET1^DIQ(200,ACT,.01),HLECH)
.F LP=1:1:$L(NM,$E(HLECH)) S VAL=$P(NM,$E(HLECH),LP) D
..D SET(.ARY,VAL,19,LP+1) ; Acting provider
S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
D PREPARY^APSPES1(.DATA,"RXO",.ARY)
D SET(.ARY,0,13,1) ; Refill count to zero
S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
D PREPARY^APSPES1(.DATA,"RXR",.ARY)
S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
D PREPARY^APSPES1(.DATA,"RXE",.ARY)
S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
D PREPARY^APSPES1(.DATA,"RXD",.ARY)
D SET(.ARY,0,8,1) ; Refill count to zero
S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
S LP=0
S FLG=0 F I=1:1 D Q:FLG
.S LP=$$FSEGIEN^APSPES1(.DATA,"DG1",LP)
.I LP=0 S FLG=1 Q
.D PREPARY^APSPES1(.DATA,"DG1",.ARY,LP-1)
.S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
Q
; Send accept message
; Input: ORID - ^OR(100 IEN
ACCEPT(RXIEN,ORID,MSGTXT) ;
N RR,DATA,HLMSGIEN,HLMSTATE,ARY,SEG,SEGIEN,SEGRXO,DFN,PROV
N PARMS,HLST,ERR,PRN,REF,REFILLS,I,FLG,LP,DISP,OCC,ACT
N RX0,RX2,HLFS,HLECH,SSNUM,RRPRV
S REFILLS=$$GET1^DIQ(52,RXIEN,9,"I")
S DFN=$$GET1^DIQ(52,RXIEN,2,"I")
S RX0=^PSRX(RXIEN,0)
S PROV=$P(RX0,U,4)
S RX2=^PSRX(RXIEN,2)
S DISP=REFILLS+1 ; Number of dispenses
S RR=$$VALUE^ORCSAVE2(+ORID,"SSRREQIEN")
Q:'RR
S HLMSGIEN=$$GET1^DIQ(9009033.91,RR,.05) ; Message ID
; TODO- Add logic to use the HL7 message text in the RR entry if HL7 message has been purged.
Q:'HLMSGIEN
S PARMS("ACK CODE")="AA"
S PARMS("MESSAGE TYPE")="RRE"
S PARMS("EVENT")="O26"
S PARMS("VERSION")=2.5
S PARMS("ACCEPT ACK TYPE")="AL"
S MSGTXT=$G(MSGTXT,"")
D PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
S HLFS=$G(DATA("HDR","FIELD SEPARATOR"))
S HLECH=$G(DATA("HDR","ENCODING CHARACTERS"))
I $$ACK^HLOAPI2(.HLMSTATE,.PARMS,.HLST,.ERR) D
.;TODO - SEND NOTIFICATION ON ERROR
.S PRN=$$GETVAL^APSPES2(HLMSGIEN,"ORC",7,7)="PRN" ; Check for PRN value
.S REF=+$$GETVAL^APSPES2(HLMSGIEN,"RXO",13,1) ; incoming Refill count
.;Get PID information as for a new order
.D PID^APSPES1(DFN)
.;S OCC=$S(PRN:"AF",'REF:"AF",DISP'=REF:"CF",1:"AF")
.S ACT=$$GET1^DIQ(9009033.91,RR,.08,"I")
.S OCC=$S(ACT=1:"AF",ACT=2:"CF",1:"AF")
.D ORCNW^APSPES1(OCC,0)
.S SSNUM=$$GET1^DIQ(9009033.91,RR,.1)
.D SET(.ARY,SSNUM,3,1) ;Set the surescripts number into ORC3
.I OCC="CF" D
..N NM,LP,VAL
..S RRPRV=$$GET1^DIQ(9009033.91,RR,1.3,"I")
..I PROV'=RRPRV D
...D SET(.ARY,PROV,19,1)
...S NM=$$HLNAME^HLFNC($$GET1^DIQ(200,PROV,.01),HLECH)
...F LP=1:1:$L(NM,$E(HLECH)) S VAL=$P(NM,$E(HLECH),LP) D
....D SET(.ARY,VAL,19,LP+1) ; Acting provider
...D SET(.ARY,$$SPI^APSPES1(RRPRV),12,1)
...S NM=$$HLNAME^HLFNC($$GET1^DIQ(200,RRPRV,.01),HLECH)
...F LP=1:1:$L(NM,$E(HLECH)) S VAL=$P(NM,$E(HLECH),LP) D
....D SET(.ARY,VAL,12,LP+1) ;Original Provider
.;D PREPARY^APSPES1(.DATA,"ORC",.ARY)
.;TODO - ADJUST RX NUMBER, CHECK REFILL PRN $S(ORC 7.7="PRN" OR RXO13.1=REFILL SET APPROVED (AF), RXO 13.1<>REFILLS SET TO APPROVED WITH CHANGES (CF)
.;D SET(.ARY,$S(PRN:"AF",'REF:"AF",DISP'=REF:"CF",1:"AF"),1) ; Order Control Code - Accept
.;D SET(.ARY,RX,2) ; Prescription number
.;D SET(.ARY,$$HLDATE^HLFNC($$NOW^XLFDT()),9) ; Written Date/Time
.;D SET(.ARY,"AM",16,1) ; Order Control Code Reason Identifier
.S SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
.D RXO^APSPES1(0)
.D SET(.ARY,DISP,13,1) ; Set refill count to # of dispenses
.S SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
.D PREPARY^APSPES1(.DATA,"RXD",.ARY)
.D SET(.ARY,$$HLDATE^HLFNC($$NOW^XLFDT(),"DT"),3)
.D SET(.ARY,DISP,8,1) ; Set refill count to # of dispenses
.S SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
.D RXR^APSPES1
.D PREPARY^APSPES1(.DATA,"RXE",.ARY)
.S SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
.D RXC^APSPES1,DG1^APSPES1,AL1^APSPES1
.;S LP=0
.;S FLG=0 F I=1:1 D Q:FLG
.;.S LP=$$FSEGIEN^APSPES1(.DATA,"DG1",LP)
.;.I LP=0 S FLG=1 Q
.;.D PREPARY^APSPES1(.DATA,"DG1",.ARY,LP-1)
.;.S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
.I '$$SENDACK^HLOAPI2(.HLST,.ERR) D UPTRRACT(RR,$G(ERR,"There was a problem sending the HL7 message."))
E D UPTRRACT(RR,$G(ERR,"There was a problem with generation the HL7 message."))
K FDA,ERR
S FDA(9009033.91,RR_",",.03)=2 ; Set status to processed-accepted
S FDA(9009033.91,RR_",",.07)=$$NOW^XLFDT()
D FILE^DIE("","FDA","ERR")
I $D(ERR) D UPTRRACT(RR,$G(ERR(1),"Error updating status"))
; Update activity log
I RXIEN D
.N LOG,RET
.S LOG("REASON")="X"
.S LOG("RX REF")=0
.S LOG("TYPE")="U"
.S LOG("COM")="eRx "_$$GET1^DIQ(9009033.91,RR,.08)_" response sent to "_$$PHMINFO^APSPES2(RXIEN)
.D UPTLOG^APSPFNC2(.RET,RXIEN,0,.LOG)
Q
;
SET(ARY,V,F,C,S,R) ;EP
D SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
Q
; Supports Refill Request Queue Deny message
; Input - IEN to APSP REFILL REQUEST file
DENYRPC(DATA,RR,MSGTXT) ;EP-
S DATA=1
Q:'$G(RR)
D DENY1
Q
; Update activity multiple of APSP Refill Request file
UPTRRACT(IEN,MSG) ;EP-
N FDA,IENS,ERR,FN
S IENS="+1,"_IEN_","
S FN=9009033.916
S FDA(FN,IENS,.01)=$$NOW^XLFDT()
S FDA(FN,IENS,.02)=$E($G(MSG,"NO MESSAGE TEXT"),1,160)
S FDA(FN,IENS,.03)=$G(DUZ)
D UPDATE^DIE(,"FDA",,"ERR")
Q
ARSPRRE ; EP - callback for RRE/O26 event
N AACK,MSG,WHO,OPRV,ARY,RET,RXIEN,DATA,HLMSTATE,MSA
N SEGIEN,SEGMSA,MSGIEN,SEGERR,ERRTXT,ORDCTL,TXT
S MSGIEN=0
D PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
S SEGIEN=$$FSEGIEN^APSPES1(.DATA,"MSA")
I 'SEGIEN D Q
.D BADORP^APSPES4
M SEGMSA=DATA(SEGIEN)
S MSGIEN=+$P($$GET^HLOPRS(.SEGMSA,2)," ",2)
S AACK=$$GET^HLOPRS(.SEGMSA,1)
S TXT=$$GET^HLOPRS(.SEGMSA,3)
I AACK'="AA" D
.S SEGIEN=$$FSEGIEN^APSPES1(.DATA,"ERR")
.M SEGERR=DATA(SEGIEN)
.S ERRTXT=$$GET^HLOPRS(.SEGERR,8)
S RXIEN=$$RXIEN^APSPES2(MSGIEN)
S OPRV=$$OPRV^APSPES2(MSGIEN)
S ARY("REASON")="X"
S ARY("RX REF")=0
S ARY("USER")=OPRV
I AACK'="AA" D Q
.D BADORP^APSPES4
.;Only send notification if it was an Accept message
.S ORDCTL=$$ORDCTL(MSGIEN)
.I RXIEN D
..S ARY("TYPE")="F"
..S ARY("COM")=$S($L($G(ERRTXT)):ERRTXT,1:"ERROR: Electronic Prescription did not transmit.")
..D UPTLOG^APSPFNC2(.RET,RXIEN,0,.ARY)
..I ORDCTL="AF"!(ORDCTL="CF") D NOTIF^APSPES4(RXIEN,"ERROR: Electronic Prescription did not transmit.",$S($L($G(ERRTXT)):ERRTXT,1:"Transmission was not accepted"))
Q:'RXIEN
S ARY("TYPE")="U"
S ARY("COM")=$S(TXT'="":TXT,1:"eRx update: Prescription delivered to pharmacy.")
;"e-Pres update: Received STATUS update."
D UPTLOG^APSPFNC2(.RET,RXIEN,0,.ARY)
Q
ORDCTL(MSGIEN) ; EP
N CTL,SEGORC
D PARSE^APSPES2(.DATA,MSGIEN,.HLMSTATE)
S SEGIEN=$$FSEGIEN^APSPES1(.DATA,"ORC")
Q:'SEGIEN 0
M SEGORC=DATA(SEGIEN)
S CTL=$$GET^HLOPRS(.SEGORC,1,1)
Q CTL
;
DCORIG(RET,ORIEN) ; EP
;DC the original order on a deny message
N ORGPKGID,ORXNUM,REA,MSG,DA,ORGIEN,PSCAN
S RET=""
S ORIEN=+$G(ORIEN)
S ORGIEN=$$GET1^DIQ(100,ORIEN,9)
Q:'+ORGIEN
S STAT=$$GET1^DIQ(100,ORGIEN,5,"I")
Q:STAT=1!(STAT=12)!(STAT=13)
S ORGPKGID=+$$GET1^DIQ(100,ORGIEN,33,"I")
Q:'ORGPKGID
S ORXNUM=$$GET1^DIQ(52,ORGPKGID,.01)
S REA="C",DA=ORGPKGID
S MSG="Provider denied Surescripts refill request"
S PSCAN(ORXNUM)=DA_"^C"
D CAN^PSOCAN
Q
ISRENEW(DATA,ORIEN) ;EP
;See if the new order is a auto-renewal order
S DATA=$$GET1^DIQ(100,+$G(ORIEN),9)>0
Q
APSPES3 ;IHS/MSC/PLS - SureScripts HL7 interface - con't;10-Sep-2013 09:40;PLS
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1008,1011,1013,1016**;Sep 23, 2004;Build 74
+2 ; Send denial message
+3 ; Input: ORID - ^OR(100 IEN
+4 ; RXIEN - Prescription IEN
+5 ; OCC - Order Control Code (default to DF)
+6 ; MSGTXT - optional
+7 ; STA - Status (default to 3)
DENY(ORID,RXIEN,OCC,MSGTXT,STA) ;
+1 NEW RR
+2 SET RR=$$VALUE^ORCSAVE2(+ORID,"SSRREQIEN")
+3 IF 'RR
QUIT
DENY1 NEW DATA,HLMSGIEN,HLMSTATE,ARY,SEG,ACT,HLECH,HLFS
+1 NEW PARMS,ACK,ERR,I,FLG,LP,LOG,DNYC,DNYR,DFN,ACTUSR
+2 SET ORID=+$GET(ORID)
+3 SET RXIEN=+$GET(RXIEN)
+4 SET ACT=$$GET1^DIQ(9009033.91,RR,.08,"I")
+5 SET ACTUSR=$$GET1^DIQ(9009033.91,RR,.09,"I")
+6 SET DFN=$$GET1^DIQ(9009033.91,RR,1.2,"I")
+7 ;S OCC=$G(OCC,"DF")
+8 SET OCC=$SELECT($GET(OCC):OCC,ACT=3:"RP",ACT=4:"DF",1:"DF")
+9 ; Message ID
SET HLMSGIEN=$$GET1^DIQ(9009033.91,RR,.05)
+10 ; TODO- Add logic to use the HL7 message text in the RR entry if HL7 message has been purged.
+11 IF 'HLMSGIEN
QUIT
+12 SET PARMS("ACK CODE")="AA"
+13 SET PARMS("MESSAGE TYPE")="RRE"
+14 SET PARMS("EVENT")="O26"
+15 SET PARMS("VERSION")=2.5
+16 SET PARMS("ACCEPT ACK TYPE")="AL"
+17 IF $LENGTH($GET(MSGTXT))
Begin DoDot:1
+18 IF $LENGTH($PIECE(MSGTXT,"-",1))
SET DNYC=$PIECE(MSGTXT,"-",1)
SET MSGTXT=$PIECE(MSGTXT,"-",2)
+19 IF '$TEST
SET DNYC="AF"
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 SET DNYR=$$VALUE^ORCSAVE2(+ORID,"SSDENYRSN")
+22 IF $LENGTH(DNYR)
Begin DoDot:2
+23 SET DNYC=$PIECE(DNYR,"-")
+24 SET MSGTXT=$PIECE(DNYR,"-",2)
End DoDot:2
+25 IF '$TEST
SET DNYC="AF"
End DoDot:1
+26 SET MSGTXT=$GET(MSGTXT,"Have patient return to clinic.")
+27 DO PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
+28 SET HLFS=$GET(DATA("HDR","FIELD SEPARATOR"))
+29 SET HLECH=HLMSTATE("HDR","ENCODING CHARACTERS")
+30 IF $$ACK^HLOAPI2(.HLMSTATE,.PARMS,.ACK,.ERR)
Begin DoDot:1
+31 DO SETACK
+32 IF '$$SENDACK^HLOAPI2(.ACK,.ERR)
DO UPTRRACT(RR,$GET(ERR,"There was a problem sending the HL7 message."))
End DoDot:1
+33 IF '$TEST
DO UPTRRACT(RR,$GET(ERR,"There was a problem generating the HL7 message."))
+34 KILL FDA,ERR
+35 ; Remove order ien
IF +$$GET1^DIQ(9009033.91,RR,.08,"I")'=3
SET FDA(9009033.91,RR_",",.02)="@"
+36 ; Set status to processed-denied
SET FDA(9009033.91,RR_",",.03)=$SELECT($GET(STA):STA,+$$GET1^DIQ(9009033.91,RR,.08,"I")=3:5,1:3)
+37 SET FDA(9009033.91,RR_",",.07)=$$NOW^XLFDT()
+38 SET FDA(9009033.91,RR_",",4)=$GET(DNYC)_"-"_$GET(MSGTXT)
+39 IF ACTUSR=""
SET FDA(9009033.91,RR_",",.09)=DUZ
+40 DO FILE^DIE(,"FDA","ERR")
+41 ; Get original order prescription IEN
+42 IF 'RXIEN
Begin DoDot:1
+43 NEW SEGIEN,SEGORC
+44 DO PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
+45 SET SEGIEN=$$FSEGIEN^APSPES1(.DATA,"ORC")
+46 IF SEGIEN
Begin DoDot:2
+47 MERGE SEGORC=DATA(SEGIEN)
+48 SET RXIEN=$$GET^HLOPRS(.SEGORC,2,1)
End DoDot:2
End DoDot:1
+49 ; Update activity log
+50 IF RXIEN
Begin DoDot:1
+51 NEW LOG,RET
+52 SET LOG("REASON")="X"
+53 SET LOG("RX REF")=0
+54 SET ARY("TYPE")="U"
+55 SET LOG("COM")="eRx denial response sent to "_$$PHMINFO^APSPES2(RXIEN)
+56 DO UPTLOG^APSPFNC2(.RET,RXIEN,0,.LOG)
End DoDot:1
+57 QUIT
SETACK ;Get original message to include in ack
+1 NEW PRV,ACT,NM,LP,VAL,INST,MRN
+2 DO PREPARY^APSPES1(.DATA,"PID",.ARY)
+3 ;Get pt id
+4 ; Patient HRN
IF $GET(DFN)
DO SET(.ARY,$$HRCNF^BDGF2(DFN,+$GET(DUZ(2))),3,1)
+5 SET SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
+6 ; Order Control Code
DO SET(.ARY,OCC,1)
+7 DO PREPARY^APSPES1(.DATA,"ORC",.ARY)
+8 ; Order Control Code
DO SET(.ARY,OCC,1)
+9 ; Written Date/Time
DO SET(.ARY,$$HLDATE^HLFNC($$NOW^XLFDT()),9)
+10 ; Order Control Code Reason Identifier
DO SET(.ARY,DNYC,16,1)
+11 ; Order Control Code Reason Text
DO SET(.ARY,$EXTRACT(MSGTXT,1,70),16,2)
+12 ; Order Control Code Reason System
DO SET(.ARY,"NCPDP1131",16,3)
+13 ; Institution Name
DO SET(.ARY,$$GET1^DIQ(4,+$GET(DUZ(2)),.01),21)
+14 SET PRV=$$GET1^DIQ(9009033.91,RR,1.3,"I")
+15 SET ACT=$$GET1^DIQ(9009033.91,RR,.09,"I")
+16 IF +PRV'=+ACT
Begin DoDot:1
+17 DO SET(.ARY,ACT,19,1)
+18 SET NM=$$HLNAME^HLFNC($$GET1^DIQ(200,ACT,.01),HLECH)
+19 FOR LP=1:1:$LENGTH(NM,$EXTRACT(HLECH))
SET VAL=$PIECE(NM,$EXTRACT(HLECH),LP)
Begin DoDot:2
+20 ; Acting provider
DO SET(.ARY,VAL,19,LP+1)
End DoDot:2
End DoDot:1
+21 SET SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
+22 DO PREPARY^APSPES1(.DATA,"RXO",.ARY)
+23 ; Refill count to zero
DO SET(.ARY,0,13,1)
+24 SET SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
+25 DO PREPARY^APSPES1(.DATA,"RXR",.ARY)
+26 SET SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
+27 DO PREPARY^APSPES1(.DATA,"RXE",.ARY)
+28 SET SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
+29 DO PREPARY^APSPES1(.DATA,"RXD",.ARY)
+30 ; Refill count to zero
DO SET(.ARY,0,8,1)
+31 SET SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
+32 SET LP=0
+33 SET FLG=0
FOR I=1:1
Begin DoDot:1
+34 SET LP=$$FSEGIEN^APSPES1(.DATA,"DG1",LP)
+35 IF LP=0
SET FLG=1
QUIT
+36 DO PREPARY^APSPES1(.DATA,"DG1",.ARY,LP-1)
+37 SET SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
End DoDot:1
IF FLG
QUIT
+38 QUIT
+39 ; Send accept message
+40 ; Input: ORID - ^OR(100 IEN
ACCEPT(RXIEN,ORID,MSGTXT) ;
+1 NEW RR,DATA,HLMSGIEN,HLMSTATE,ARY,SEG,SEGIEN,SEGRXO,DFN,PROV
+2 NEW PARMS,HLST,ERR,PRN,REF,REFILLS,I,FLG,LP,DISP,OCC,ACT
+3 NEW RX0,RX2,HLFS,HLECH,SSNUM,RRPRV
+4 SET REFILLS=$$GET1^DIQ(52,RXIEN,9,"I")
+5 SET DFN=$$GET1^DIQ(52,RXIEN,2,"I")
+6 SET RX0=^PSRX(RXIEN,0)
+7 SET PROV=$PIECE(RX0,U,4)
+8 SET RX2=^PSRX(RXIEN,2)
+9 ; Number of dispenses
SET DISP=REFILLS+1
+10 SET RR=$$VALUE^ORCSAVE2(+ORID,"SSRREQIEN")
+11 IF 'RR
QUIT
+12 ; Message ID
SET HLMSGIEN=$$GET1^DIQ(9009033.91,RR,.05)
+13 ; TODO- Add logic to use the HL7 message text in the RR entry if HL7 message has been purged.
+14 IF 'HLMSGIEN
QUIT
+15 SET PARMS("ACK CODE")="AA"
+16 SET PARMS("MESSAGE TYPE")="RRE"
+17 SET PARMS("EVENT")="O26"
+18 SET PARMS("VERSION")=2.5
+19 SET PARMS("ACCEPT ACK TYPE")="AL"
+20 SET MSGTXT=$GET(MSGTXT,"")
+21 DO PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
+22 SET HLFS=$GET(DATA("HDR","FIELD SEPARATOR"))
+23 SET HLECH=$GET(DATA("HDR","ENCODING CHARACTERS"))
+24 IF $$ACK^HLOAPI2(.HLMSTATE,.PARMS,.HLST,.ERR)
Begin DoDot:1
+25 ;TODO - SEND NOTIFICATION ON ERROR
+26 ; Check for PRN value
SET PRN=$$GETVAL^APSPES2(HLMSGIEN,"ORC",7,7)="PRN"
+27 ; incoming Refill count
SET REF=+$$GETVAL^APSPES2(HLMSGIEN,"RXO",13,1)
+28 ;Get PID information as for a new order
+29 DO PID^APSPES1(DFN)
+30 ;S OCC=$S(PRN:"AF",'REF:"AF",DISP'=REF:"CF",1:"AF")
+31 SET ACT=$$GET1^DIQ(9009033.91,RR,.08,"I")
+32 SET OCC=$SELECT(ACT=1:"AF",ACT=2:"CF",1:"AF")
+33 DO ORCNW^APSPES1(OCC,0)
+34 SET SSNUM=$$GET1^DIQ(9009033.91,RR,.1)
+35 ;Set the surescripts number into ORC3
DO SET(.ARY,SSNUM,3,1)
+36 IF OCC="CF"
Begin DoDot:2
+37 NEW NM,LP,VAL
+38 SET RRPRV=$$GET1^DIQ(9009033.91,RR,1.3,"I")
+39 IF PROV'=RRPRV
Begin DoDot:3
+40 DO SET(.ARY,PROV,19,1)
+41 SET NM=$$HLNAME^HLFNC($$GET1^DIQ(200,PROV,.01),HLECH)
+42 FOR LP=1:1:$LENGTH(NM,$EXTRACT(HLECH))
SET VAL=$PIECE(NM,$EXTRACT(HLECH),LP)
Begin DoDot:4
+43 ; Acting provider
DO SET(.ARY,VAL,19,LP+1)
End DoDot:4
+44 DO SET(.ARY,$$SPI^APSPES1(RRPRV),12,1)
+45 SET NM=$$HLNAME^HLFNC($$GET1^DIQ(200,RRPRV,.01),HLECH)
+46 FOR LP=1:1:$LENGTH(NM,$EXTRACT(HLECH))
SET VAL=$PIECE(NM,$EXTRACT(HLECH),LP)
Begin DoDot:4
+47 ;Original Provider
DO SET(.ARY,VAL,12,LP+1)
End DoDot:4
End DoDot:3
End DoDot:2
+48 ;D PREPARY^APSPES1(.DATA,"ORC",.ARY)
+49 ;TODO - ADJUST RX NUMBER, CHECK REFILL PRN $S(ORC 7.7="PRN" OR RXO13.1=REFILL SET APPROVED (AF), RXO 13.1<>REFILLS SET TO APPROVED WITH CHANGES (CF)
+50 ;D SET(.ARY,$S(PRN:"AF",'REF:"AF",DISP'=REF:"CF",1:"AF"),1) ; Order Control Code - Accept
+51 ;D SET(.ARY,RX,2) ; Prescription number
+52 ;D SET(.ARY,$$HLDATE^HLFNC($$NOW^XLFDT()),9) ; Written Date/Time
+53 ;D SET(.ARY,"AM",16,1) ; Order Control Code Reason Identifier
+54 SET SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
+55 DO RXO^APSPES1(0)
+56 ; Set refill count to # of dispenses
DO SET(.ARY,DISP,13,1)
+57 SET SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
+58 DO PREPARY^APSPES1(.DATA,"RXD",.ARY)
+59 DO SET(.ARY,$$HLDATE^HLFNC($$NOW^XLFDT(),"DT"),3)
+60 ; Set refill count to # of dispenses
DO SET(.ARY,DISP,8,1)
+61 SET SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
+62 DO RXR^APSPES1
+63 DO PREPARY^APSPES1(.DATA,"RXE",.ARY)
+64 SET SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
+65 DO RXC^APSPES1
DO DG1^APSPES1
DO AL1^APSPES1
+66 ;S LP=0
+67 ;S FLG=0 F I=1:1 D Q:FLG
+68 ;.S LP=$$FSEGIEN^APSPES1(.DATA,"DG1",LP)
+69 ;.I LP=0 S FLG=1 Q
+70 ;.D PREPARY^APSPES1(.DATA,"DG1",.ARY,LP-1)
+71 ;.S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
+72 IF '$$SENDACK^HLOAPI2(.HLST,.ERR)
DO UPTRRACT(RR,$GET(ERR,"There was a problem sending the HL7 message."))
End DoDot:1
+73 IF '$TEST
DO UPTRRACT(RR,$GET(ERR,"There was a problem with generation the HL7 message."))
+74 KILL FDA,ERR
+75 ; Set status to processed-accepted
SET FDA(9009033.91,RR_",",.03)=2
+76 SET FDA(9009033.91,RR_",",.07)=$$NOW^XLFDT()
+77 DO FILE^DIE("","FDA","ERR")
+78 IF $DATA(ERR)
DO UPTRRACT(RR,$GET(ERR(1),"Error updating status"))
+79 ; Update activity log
+80 IF RXIEN
Begin DoDot:1
+81 NEW LOG,RET
+82 SET LOG("REASON")="X"
+83 SET LOG("RX REF")=0
+84 SET LOG("TYPE")="U"
+85 SET LOG("COM")="eRx "_$$GET1^DIQ(9009033.91,RR,.08)_" response sent to "_$$PHMINFO^APSPES2(RXIEN)
+86 DO UPTLOG^APSPFNC2(.RET,RXIEN,0,.LOG)
End DoDot:1
+87 QUIT
+88 ;
SET(ARY,V,F,C,S,R) ;EP
+1 DO SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
+2 QUIT
+3 ; Supports Refill Request Queue Deny message
+4 ; Input - IEN to APSP REFILL REQUEST file
DENYRPC(DATA,RR,MSGTXT) ;EP-
+1 SET DATA=1
+2 IF '$GET(RR)
QUIT
+3 DO DENY1
+4 QUIT
+5 ; Update activity multiple of APSP Refill Request file
UPTRRACT(IEN,MSG) ;EP-
+1 NEW FDA,IENS,ERR,FN
+2 SET IENS="+1,"_IEN_","
+3 SET FN=9009033.916
+4 SET FDA(FN,IENS,.01)=$$NOW^XLFDT()
+5 SET FDA(FN,IENS,.02)=$EXTRACT($GET(MSG,"NO MESSAGE TEXT"),1,160)
+6 SET FDA(FN,IENS,.03)=$GET(DUZ)
+7 DO UPDATE^DIE(,"FDA",,"ERR")
+8 QUIT
ARSPRRE ; EP - callback for RRE/O26 event
+1 NEW AACK,MSG,WHO,OPRV,ARY,RET,RXIEN,DATA,HLMSTATE,MSA
+2 NEW SEGIEN,SEGMSA,MSGIEN,SEGERR,ERRTXT,ORDCTL,TXT
+3 SET MSGIEN=0
+4 DO PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
+5 SET SEGIEN=$$FSEGIEN^APSPES1(.DATA,"MSA")
+6 IF 'SEGIEN
Begin DoDot:1
+7 DO BADORP^APSPES4
End DoDot:1
QUIT
+8 MERGE SEGMSA=DATA(SEGIEN)
+9 SET MSGIEN=+$PIECE($$GET^HLOPRS(.SEGMSA,2)," ",2)
+10 SET AACK=$$GET^HLOPRS(.SEGMSA,1)
+11 SET TXT=$$GET^HLOPRS(.SEGMSA,3)
+12 IF AACK'="AA"
Begin DoDot:1
+13 SET SEGIEN=$$FSEGIEN^APSPES1(.DATA,"ERR")
+14 MERGE SEGERR=DATA(SEGIEN)
+15 SET ERRTXT=$$GET^HLOPRS(.SEGERR,8)
End DoDot:1
+16 SET RXIEN=$$RXIEN^APSPES2(MSGIEN)
+17 SET OPRV=$$OPRV^APSPES2(MSGIEN)
+18 SET ARY("REASON")="X"
+19 SET ARY("RX REF")=0
+20 SET ARY("USER")=OPRV
+21 IF AACK'="AA"
Begin DoDot:1
+22 DO BADORP^APSPES4
+23 ;Only send notification if it was an Accept message
+24 SET ORDCTL=$$ORDCTL(MSGIEN)
+25 IF RXIEN
Begin DoDot:2
+26 SET ARY("TYPE")="F"
+27 SET ARY("COM")=$SELECT($LENGTH($GET(ERRTXT)):ERRTXT,1:"ERROR: Electronic Prescription did not transmit.")
+28 DO UPTLOG^APSPFNC2(.RET,RXIEN,0,.ARY)
+29 IF ORDCTL="AF"!(ORDCTL="CF")
DO NOTIF^APSPES4(RXIEN,"ERROR: Electronic Prescription did not transmit.",$SELECT($LENGTH($GET(ERRTXT)):ERRTXT,1:"Transmission was not accepted"))
End DoDot:2
End DoDot:1
QUIT
+30 IF 'RXIEN
QUIT
+31 SET ARY("TYPE")="U"
+32 SET ARY("COM")=$SELECT(TXT'="":TXT,1:"eRx update: Prescription delivered to pharmacy.")
+33 ;"e-Pres update: Received STATUS update."
+34 DO UPTLOG^APSPFNC2(.RET,RXIEN,0,.ARY)
+35 QUIT
ORDCTL(MSGIEN) ; EP
+1 NEW CTL,SEGORC
+2 DO PARSE^APSPES2(.DATA,MSGIEN,.HLMSTATE)
+3 SET SEGIEN=$$FSEGIEN^APSPES1(.DATA,"ORC")
+4 IF 'SEGIEN
QUIT 0
+5 MERGE SEGORC=DATA(SEGIEN)
+6 SET CTL=$$GET^HLOPRS(.SEGORC,1,1)
+7 QUIT CTL
+8 ;
DCORIG(RET,ORIEN) ; EP
+1 ;DC the original order on a deny message
+2 NEW ORGPKGID,ORXNUM,REA,MSG,DA,ORGIEN,PSCAN
+3 SET RET=""
+4 SET ORIEN=+$GET(ORIEN)
+5 SET ORGIEN=$$GET1^DIQ(100,ORIEN,9)
+6 IF '+ORGIEN
QUIT
+7 SET STAT=$$GET1^DIQ(100,ORGIEN,5,"I")
+8 IF STAT=1!(STAT=12)!(STAT=13)
QUIT
+9 SET ORGPKGID=+$$GET1^DIQ(100,ORGIEN,33,"I")
+10 IF 'ORGPKGID
QUIT
+11 SET ORXNUM=$$GET1^DIQ(52,ORGPKGID,.01)
+12 SET REA="C"
SET DA=ORGPKGID
+13 SET MSG="Provider denied Surescripts refill request"
+14 SET PSCAN(ORXNUM)=DA_"^C"
+15 DO CAN^PSOCAN
+16 QUIT
ISRENEW(DATA,ORIEN) ;EP
+1 ;See if the new order is a auto-renewal order
+2 SET DATA=$$GET1^DIQ(100,+$GET(ORIEN),9)>0
+3 QUIT
