Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APSPES3

APSPES3.m

Go to the documentation of this file. 
  1. 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
  1.  ; Send denial message
  1.  ; Input:  ORID - ^OR(100 IEN
  1.  ;        RXIEN - Prescription IEN
  1.  ;          OCC - Order Control Code  (default to DF)
  1.  ;       MSGTXT - optional
  1.  ;          STA - Status (default to 3)
  1. DENY(ORID,RXIEN,OCC,MSGTXT,STA) ;
  1.  N RR
  1.  S RR=$$VALUE^ORCSAVE2(+ORID,"SSRREQIEN")
  1.  Q:'RR
  1. DENY1 N DATA,HLMSGIEN,HLMSTATE,ARY,SEG,ACT,HLECH,HLFS
  1.  N PARMS,ACK,ERR,I,FLG,LP,LOG,DNYC,DNYR,DFN,ACTUSR
  1.  S ORID=+$G(ORID)
  1.  S RXIEN=+$G(RXIEN)
  1.  S ACT=$$GET1^DIQ(9009033.91,RR,.08,"I")
  1.  S ACTUSR=$$GET1^DIQ(9009033.91,RR,.09,"I")
  1.  S DFN=$$GET1^DIQ(9009033.91,RR,1.2,"I")
  1.  ;S OCC=$G(OCC,"DF")
  1.  S OCC=$S($G(OCC):OCC,ACT=3:"RP",ACT=4:"DF",1:"DF")
  1.  S HLMSGIEN=$$GET1^DIQ(9009033.91,RR,.05)  ; Message ID
  1.  ; TODO- Add logic to use the HL7 message text in the RR entry if HL7 message has been purged.
  1.  Q:'HLMSGIEN
  1.  S PARMS("ACK CODE")="AA"
  1.  S PARMS("MESSAGE TYPE")="RRE"
  1.  S PARMS("EVENT")="O26"
  1.  S PARMS("VERSION")=2.5
  1.  S PARMS("ACCEPT ACK TYPE")="AL"
  1.  I $L($G(MSGTXT)) D
  1.  .I $L($P(MSGTXT,"-",1)) S DNYC=$P(MSGTXT,"-",1),MSGTXT=$P(MSGTXT,"-",2)
  1.  .E  S DNYC="AF"
  1.  E  D
  1.  .S DNYR=$$VALUE^ORCSAVE2(+ORID,"SSDENYRSN")
  1.  .I $L(DNYR) D
  1.  ..S DNYC=$P(DNYR,"-")
  1.  ..S MSGTXT=$P(DNYR,"-",2)
  1.  .E  S DNYC="AF"
  1.  S MSGTXT=$G(MSGTXT,"Have patient return to clinic.")
  1.  D PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
  1.  S HLFS=$G(DATA("HDR","FIELD SEPARATOR"))
  1.  S HLECH=HLMSTATE("HDR","ENCODING CHARACTERS")
  1.  I $$ACK^HLOAPI2(.HLMSTATE,.PARMS,.ACK,.ERR) D
  1.  .D SETACK
  1.  .I '$$SENDACK^HLOAPI2(.ACK,.ERR) D UPTRRACT(RR,$G(ERR,"There was a problem sending the HL7 message."))
  1.  E  D UPTRRACT(RR,$G(ERR,"There was a problem generating the HL7 message."))
  1.  K FDA,ERR
  1.  S:+$$GET1^DIQ(9009033.91,RR,.08,"I")'=3 FDA(9009033.91,RR_",",.02)="@"  ; Remove order ien
  1.  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
  1.  S FDA(9009033.91,RR_",",.07)=$$NOW^XLFDT()
  1.  S FDA(9009033.91,RR_",",4)=$G(DNYC)_"-"_$G(MSGTXT)
  1.  I ACTUSR="" S FDA(9009033.91,RR_",",.09)=DUZ
  1.  D FILE^DIE(,"FDA","ERR")
  1.  ; Get original order prescription IEN
  1.  I 'RXIEN D
  1.  .N SEGIEN,SEGORC
  1.  .D PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
  1.  .S SEGIEN=$$FSEGIEN^APSPES1(.DATA,"ORC")
  1.  .I SEGIEN D
  1.  ..M SEGORC=DATA(SEGIEN)
  1.  ..S RXIEN=$$GET^HLOPRS(.SEGORC,2,1)
  1.  ; Update activity log
  1.  I RXIEN D
  1.  .N LOG,RET
  1.  .S LOG("REASON")="X"
  1.  .S LOG("RX REF")=0
  1.  .S ARY("TYPE")="U"
  1.  .S LOG("COM")="eRx denial response sent to "_$$PHMINFO^APSPES2(RXIEN)
  1.  .D UPTLOG^APSPFNC2(.RET,RXIEN,0,.LOG)
  1.  Q
  1. SETACK ;Get original message to include in ack
  1.  N PRV,ACT,NM,LP,VAL,INST,MRN
  1.  D PREPARY^APSPES1(.DATA,"PID",.ARY)
  1.  ;Get pt id
  1.  D:$G(DFN) SET(.ARY,$$HRCNF^BDGF2(DFN,+$G(DUZ(2))),3,1)  ; Patient HRN
  1.  S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
  1.  D SET(.ARY,OCC,1)  ; Order Control Code
  1.  D PREPARY^APSPES1(.DATA,"ORC",.ARY)
  1.  D SET(.ARY,OCC,1)  ; Order Control Code
  1.  D SET(.ARY,$$HLDATE^HLFNC($$NOW^XLFDT()),9)  ; Written Date/Time
  1.  D SET(.ARY,DNYC,16,1)  ; Order Control Code Reason Identifier
  1.  D SET(.ARY,$E(MSGTXT,1,70),16,2)  ; Order Control Code Reason Text
  1.  D SET(.ARY,"NCPDP1131",16,3)  ; Order Control Code Reason System
  1.  D SET(.ARY,$$GET1^DIQ(4,+$G(DUZ(2)),.01),21)  ; Institution Name
  1.  S PRV=$$GET1^DIQ(9009033.91,RR,1.3,"I")
  1.  S ACT=$$GET1^DIQ(9009033.91,RR,.09,"I")
  1.  I +PRV'=+ACT D
  1.  .D SET(.ARY,ACT,19,1)
  1.  .S NM=$$HLNAME^HLFNC($$GET1^DIQ(200,ACT,.01),HLECH)
  1.  .F LP=1:1:$L(NM,$E(HLECH)) S VAL=$P(NM,$E(HLECH),LP) D
  1.  ..D SET(.ARY,VAL,19,LP+1)  ; Acting provider
  1.  S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
  1.  D PREPARY^APSPES1(.DATA,"RXO",.ARY)
  1.  D SET(.ARY,0,13,1)  ; Refill count to zero
  1.  S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
  1.  D PREPARY^APSPES1(.DATA,"RXR",.ARY)
  1.  S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
  1.  D PREPARY^APSPES1(.DATA,"RXE",.ARY)
  1.  S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
  1.  D PREPARY^APSPES1(.DATA,"RXD",.ARY)
  1.  D SET(.ARY,0,8,1)  ; Refill count to zero
  1.  S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
  1.  S LP=0
  1.  S FLG=0 F I=1:1 D  Q:FLG
  1.  .S LP=$$FSEGIEN^APSPES1(.DATA,"DG1",LP)
  1.  .I LP=0 S FLG=1 Q
  1.  .D PREPARY^APSPES1(.DATA,"DG1",.ARY,LP-1)
  1.  .S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
  1.  Q
  1.  ; Send accept message
  1.  ; Input:  ORID - ^OR(100 IEN
  1. ACCEPT(RXIEN,ORID,MSGTXT) ;
  1.  N RR,DATA,HLMSGIEN,HLMSTATE,ARY,SEG,SEGIEN,SEGRXO,DFN,PROV
  1.  N PARMS,HLST,ERR,PRN,REF,REFILLS,I,FLG,LP,DISP,OCC,ACT
  1.  N RX0,RX2,HLFS,HLECH,SSNUM,RRPRV
  1.  S REFILLS=$$GET1^DIQ(52,RXIEN,9,"I")
  1.  S DFN=$$GET1^DIQ(52,RXIEN,2,"I")
  1.  S RX0=^PSRX(RXIEN,0)
  1.  S PROV=$P(RX0,U,4)
  1.  S RX2=^PSRX(RXIEN,2)
  1.  S DISP=REFILLS+1  ; Number of dispenses
  1.  S RR=$$VALUE^ORCSAVE2(+ORID,"SSRREQIEN")
  1.  Q:'RR
  1.  S HLMSGIEN=$$GET1^DIQ(9009033.91,RR,.05)  ; Message ID
  1.  ; TODO- Add logic to use the HL7 message text in the RR entry if HL7 message has been purged.
  1.  Q:'HLMSGIEN
  1.  S PARMS("ACK CODE")="AA"
  1.  S PARMS("MESSAGE TYPE")="RRE"
  1.  S PARMS("EVENT")="O26"
  1.  S PARMS("VERSION")=2.5
  1.  S PARMS("ACCEPT ACK TYPE")="AL"
  1.  S MSGTXT=$G(MSGTXT,"")
  1.  D PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
  1.  S HLFS=$G(DATA("HDR","FIELD SEPARATOR"))
  1.  S HLECH=$G(DATA("HDR","ENCODING CHARACTERS"))
  1.  I $$ACK^HLOAPI2(.HLMSTATE,.PARMS,.HLST,.ERR) D
  1.  .;TODO - SEND NOTIFICATION ON ERROR
  1.  .S PRN=$$GETVAL^APSPES2(HLMSGIEN,"ORC",7,7)="PRN"  ; Check for PRN value
  1.  .S REF=+$$GETVAL^APSPES2(HLMSGIEN,"RXO",13,1)  ; incoming Refill count
  1.  .;Get PID information as for a new order
  1.  .D PID^APSPES1(DFN)
  1.  .;S OCC=$S(PRN:"AF",'REF:"AF",DISP'=REF:"CF",1:"AF")
  1.  .S ACT=$$GET1^DIQ(9009033.91,RR,.08,"I")
  1.  .S OCC=$S(ACT=1:"AF",ACT=2:"CF",1:"AF")
  1.  .D ORCNW^APSPES1(OCC,0)
  1.  .S SSNUM=$$GET1^DIQ(9009033.91,RR,.1)
  1.  .D SET(.ARY,SSNUM,3,1)   ;Set the surescripts number into ORC3
  1.  .I OCC="CF" D
  1.  ..N NM,LP,VAL
  1.  ..S RRPRV=$$GET1^DIQ(9009033.91,RR,1.3,"I")
  1.  ..I PROV'=RRPRV D
  1.  ...D SET(.ARY,PROV,19,1)
  1.  ...S NM=$$HLNAME^HLFNC($$GET1^DIQ(200,PROV,.01),HLECH)
  1.  ...F LP=1:1:$L(NM,$E(HLECH)) S VAL=$P(NM,$E(HLECH),LP) D
  1.  ....D SET(.ARY,VAL,19,LP+1)  ; Acting provider
  1.  ...D SET(.ARY,$$SPI^APSPES1(RRPRV),12,1)
  1.  ...S NM=$$HLNAME^HLFNC($$GET1^DIQ(200,RRPRV,.01),HLECH)
  1.  ...F LP=1:1:$L(NM,$E(HLECH)) S VAL=$P(NM,$E(HLECH),LP) D
  1.  ....D SET(.ARY,VAL,12,LP+1)  ;Original Provider
  1.  .;D PREPARY^APSPES1(.DATA,"ORC",.ARY)
  1.  .;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)
  1.  .;D SET(.ARY,$S(PRN:"AF",'REF:"AF",DISP'=REF:"CF",1:"AF"),1)  ; Order Control Code - Accept
  1.  .;D SET(.ARY,RX,2)  ; Prescription number
  1.  .;D SET(.ARY,$$HLDATE^HLFNC($$NOW^XLFDT()),9)  ; Written Date/Time
  1.  .;D SET(.ARY,"AM",16,1)  ; Order Control Code Reason Identifier
  1.  .S SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
  1.  .D RXO^APSPES1(0)
  1.  .D SET(.ARY,DISP,13,1)  ; Set refill count to # of dispenses
  1.  .S SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
  1.  .D PREPARY^APSPES1(.DATA,"RXD",.ARY)
  1.  .D SET(.ARY,$$HLDATE^HLFNC($$NOW^XLFDT(),"DT"),3)
  1.  .D SET(.ARY,DISP,8,1)   ; Set refill count to # of dispenses
  1.  .S SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
  1.  .D RXR^APSPES1
  1.  .D PREPARY^APSPES1(.DATA,"RXE",.ARY)
  1.  .S SEG=$$ADDSEG^HLOAPI(.HLST,.ARY)
  1.  .D RXC^APSPES1,DG1^APSPES1,AL1^APSPES1
  1.  .;S LP=0
  1.  .;S FLG=0 F I=1:1 D  Q:FLG
  1.  .;.S LP=$$FSEGIEN^APSPES1(.DATA,"DG1",LP)
  1.  .;.I LP=0 S FLG=1 Q
  1.  .;.D PREPARY^APSPES1(.DATA,"DG1",.ARY,LP-1)
  1.  .;.S SEG=$$ADDSEG^HLOAPI(.ACK,.ARY)
  1.  .I '$$SENDACK^HLOAPI2(.HLST,.ERR) D UPTRRACT(RR,$G(ERR,"There was a problem sending the HL7 message."))
  1.  E  D UPTRRACT(RR,$G(ERR,"There was a problem with generation the HL7 message."))
  1.  K FDA,ERR
  1.  S FDA(9009033.91,RR_",",.03)=2  ; Set status to processed-accepted
  1.  S FDA(9009033.91,RR_",",.07)=$$NOW^XLFDT()
  1.  D FILE^DIE("","FDA","ERR")
  1.  I $D(ERR) D UPTRRACT(RR,$G(ERR(1),"Error updating status"))
  1.  ; Update activity log
  1.  I RXIEN D
  1.  .N LOG,RET
  1.  .S LOG("REASON")="X"
  1.  .S LOG("RX REF")=0
  1.  .S LOG("TYPE")="U"
  1.  .S LOG("COM")="eRx "_$$GET1^DIQ(9009033.91,RR,.08)_" response sent to "_$$PHMINFO^APSPES2(RXIEN)
  1.  .D UPTLOG^APSPFNC2(.RET,RXIEN,0,.LOG)
  1.  Q
  1.  ;
  1. SET(ARY,V,F,C,S,R) ;EP
  1.  D SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
  1.  Q
  1.  ; Supports Refill Request Queue Deny message
  1.  ; Input - IEN to APSP REFILL REQUEST file
  1. DENYRPC(DATA,RR,MSGTXT) ;EP-
  1.  S DATA=1
  1.  Q:'$G(RR)
  1.  D DENY1
  1.  Q
  1.  ; Update activity multiple of APSP Refill Request file
  1. UPTRRACT(IEN,MSG) ;EP-
  1.  N FDA,IENS,ERR,FN
  1.  S IENS="+1,"_IEN_","
  1.  S FN=9009033.916
  1.  S FDA(FN,IENS,.01)=$$NOW^XLFDT()
  1.  S FDA(FN,IENS,.02)=$E($G(MSG,"NO MESSAGE TEXT"),1,160)
  1.  S FDA(FN,IENS,.03)=$G(DUZ)
  1.  D UPDATE^DIE(,"FDA",,"ERR")
  1.  Q
  1. ARSPRRE ; EP - callback for RRE/O26 event
  1.  N AACK,MSG,WHO,OPRV,ARY,RET,RXIEN,DATA,HLMSTATE,MSA
  1.  N SEGIEN,SEGMSA,MSGIEN,SEGERR,ERRTXT,ORDCTL,TXT
  1.  S MSGIEN=0
  1.  D PARSE^APSPES2(.DATA,HLMSGIEN,.HLMSTATE)
  1.  S SEGIEN=$$FSEGIEN^APSPES1(.DATA,"MSA")
  1.  I 'SEGIEN D  Q
  1.  .D BADORP^APSPES4
  1.  M SEGMSA=DATA(SEGIEN)
  1.  S MSGIEN=+$P($$GET^HLOPRS(.SEGMSA,2)," ",2)
  1.  S AACK=$$GET^HLOPRS(.SEGMSA,1)
  1.  S TXT=$$GET^HLOPRS(.SEGMSA,3)
  1.  I AACK'="AA" D
  1.  .S SEGIEN=$$FSEGIEN^APSPES1(.DATA,"ERR")
  1.  .M SEGERR=DATA(SEGIEN)
  1.  .S ERRTXT=$$GET^HLOPRS(.SEGERR,8)
  1.  S RXIEN=$$RXIEN^APSPES2(MSGIEN)
  1.  S OPRV=$$OPRV^APSPES2(MSGIEN)
  1.  S ARY("REASON")="X"
  1.  S ARY("RX REF")=0
  1.  S ARY("USER")=OPRV
  1.  I AACK'="AA" D  Q
  1.  .D BADORP^APSPES4
  1.  .;Only send notification if it was an Accept message
  1.  .S ORDCTL=$$ORDCTL(MSGIEN)
  1.  .I RXIEN D
  1.  ..S ARY("TYPE")="F"
  1.  ..S ARY("COM")=$S($L($G(ERRTXT)):ERRTXT,1:"ERROR: Electronic Prescription did not transmit.")
  1.  ..D UPTLOG^APSPFNC2(.RET,RXIEN,0,.ARY)
  1.  ..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"))
  1.  Q:'RXIEN
  1.  S ARY("TYPE")="U"
  1.  S ARY("COM")=$S(TXT'="":TXT,1:"eRx update: Prescription delivered to pharmacy.")
  1.  ;"e-Pres update: Received STATUS update."
  1.  D UPTLOG^APSPFNC2(.RET,RXIEN,0,.ARY)
  1.  Q
  1. ORDCTL(MSGIEN) ; EP
  1.  N CTL,SEGORC
  1.  D PARSE^APSPES2(.DATA,MSGIEN,.HLMSTATE)
  1.  S SEGIEN=$$FSEGIEN^APSPES1(.DATA,"ORC")
  1.  Q:'SEGIEN 0
  1.  M SEGORC=DATA(SEGIEN)
  1.  S CTL=$$GET^HLOPRS(.SEGORC,1,1)
  1.  Q CTL
  1.  ;
  1. DCORIG(RET,ORIEN) ; EP
  1.  ;DC the original order on a deny message
  1.  N ORGPKGID,ORXNUM,REA,MSG,DA,ORGIEN,PSCAN
  1.  S RET=""
  1.  S ORIEN=+$G(ORIEN)
  1.  S ORGIEN=$$GET1^DIQ(100,ORIEN,9)
  1.  Q:'+ORGIEN
  1.  S STAT=$$GET1^DIQ(100,ORGIEN,5,"I")
  1.  Q:STAT=1!(STAT=12)!(STAT=13)
  1.  S ORGPKGID=+$$GET1^DIQ(100,ORGIEN,33,"I")
  1.  Q:'ORGPKGID
  1.  S ORXNUM=$$GET1^DIQ(52,ORGPKGID,.01)
  1.  S REA="C",DA=ORGPKGID
  1.  S MSG="Provider denied Surescripts refill request"
  1.  S PSCAN(ORXNUM)=DA_"^C"
  1.  D CAN^PSOCAN
  1.  Q
  1. ISRENEW(DATA,ORIEN) ;EP
  1.  ;See if the new order is a auto-renewal order
  1.  S DATA=$$GET1^DIQ(100,+$G(ORIEN),9)>0
  1.  Q