PSOERXI1.m

PSOERXI1 ;ALB/BWF - eRx Utilities/RPC's ; 12/10/22 11:24am

 ;;7.0;OUTPATIENT PHARMACY;**581,617,692,706,700,743,746,783**;DEC 1997;Build 1

 ;

 ;

 ;Reference to MAKEADD^TIUSRVP2 in ICR #4795

 Q

 ; File incoming XML into appropriate file

 ; XML - xml text

 ; PRCHK - provider check information

 ; PACHK - patient check information

 ; DACHK - drug auto check

 ; STATION - station #

 ; DIV - institution name^NPI

 ; ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)^relates to hub ID

 ; ERXVALS - code values for NIST codes (potency unit code^form code^strength code^prohibit renewals - change response (y/n))

 ; XML2 - structured sig from the medication prescribed segment

 ; VADAT - DUZ^RXIEN

 ; XML3 - third stream of XML

INCERX(RES,XML,PRCHK,PACHK,DACHK,STATION,DIV,ERXHID,ERXVALS,XML2,VADAT,XML3) ;

 ;p783 This error handling prevents delays at the eRx Hub because it always returns a result

 N $ESTACK,$ETRAP S $ETRAP="D ERROR^PSOERXI1"

 N CURREC,FDA,EIEN,ERRTXT,ERRSEQ,PACNT,PASCNT,PAICN,PAIEN,VAINST,NPI,VAOI,VPATINST,PRVAUTOV

 S NPI=$P($G(DIV),U,2)

 S CURREC=$$PARSE^PSOERXI2(.XML,.ERXVALS,NPI,.XML2,.XML3)

 I $P(CURREC,U)<1 D  Q

 . I $L($P(CURREC,U,2)) S RES=CURREC Q

 . S RES="0^XML received. Error creating or finding associated record in the ERX Holding queue." Q

 S EIEN=CURREC

 S CURREC=CURREC_","

 ;If this is an outbound message, file the users DUZ and quit back the response. no drug, patient, or provider auto checks will occur

 I $G(VADAT)]"" D  Q

 . I $P($G(VADAT),U)>1 D

 . . S FDA(52.49,CURREC,51.1)=DUZ D FILE^DIE(,"FDA") K FDA

 . I $P(VADAT,U,2) D

 . . S FDA(52.49,CURREC,.13)=$P(VADAT,U,2) D FILE^DIE(,"FDA") K FDA

 . S RES="1^Erx Received."

 ;Process auto-validation results. Only log positive results for now

 K FDA

 I $P($G(VADAT),U) S RES="1^Message Filed." Q

 ;

 ;Drug Auto-Check (Moved from Hub to VistA - P-692)

 I $G(DACHK("success"))="false" D

 . N MSGTYPE,MEDSEG,MTCHDRUG,PRDCODE,PRDCOQL,DRGNAME

 . S MSGTYPE=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,"")) I MSGTYPE="" Q

 . S MEDSEG="MedicationPrescribed"

 . I '$D(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG)) D

 . . S MEDSEG="MedicationResponse"

 . S PRDCODE=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugCoded",0,"ProductCode",0,"Code",0)) I PRDCODE="" Q

 . S PRDCOQL=$E($G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugCoded",0,"ProductCode",0,"Qualifier",0)),1)

 . I PRDCOQL'="N",PRDCOQL'="U" Q

 . S DRGNAME=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugDescription",0))

 . D DRGMTCH^PSOERXA0(.MTCHDRUG,PRDCOQL_"^"_PRDCODE,DRGNAME)

 . I +$G(MTCHDRUG) D

 . . K DACHK S DACHK("success")="true",DACHK("IEN")=+MTCHDRUG

 ;

 I $G(DACHK("success"))="true" D

 . I $G(DACHK("IEN")) D

 . .;Saving the eRx Audit Log For Auto-Matched Drug

 . . S NEWVAL(1)=$$GET1^DIQ(50,DACHK("IEN"),.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(DACHK("IEN"))_")"

 . . D AUDLOG^PSOERXUT(+CURREC,"DRUG",$$PROXYDUZ^PSOERXUT(),.NEWVAL)

 . .;Setting Matched Drug and Auto Match info

 . . S FDA(52.49,CURREC,1.4)=1

 . . S FDA(52.49,CURREC,3.2)=DACHK("IEN")

 . . S FDA(52.49,CURREC,44)=1

 . . S VAOI=$$GET1^DIQ(50,DACHK("IEN"),2.1,"I")

 . . S VPATINST=$$GET1^DIQ(50.7,VAOI,7,"E")

 . . I $L(VPATINST) D

 . . . S (NEWVAL(1),FDA(52.49,CURREC,27))=VPATINST

 . . . D AUDLOG^PSOERXUT(+CURREC,"PATIENT INSTRUCTIONS",$$PROXYDUZ^PSOERXUT(),.NEWVAL)

 ;

 I $G(DACHK("success"))="false" D

 . S ERRTXT=$G(DACHK("error"))

 . S ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN) Q:'ERRSEQ

 . D FILERR^PSOERXU1(CURREC,ERRSEQ,"D","E",ERRTXT)

 ;

 ;Provider Auto-Check (Moved from Hub to VistA - P-692)

 I $G(PRCHK("success"))="false" D

 . N TMP,MSGTYPE,MTCHPROV,TMP,NPI,DEA,CS

 . S MSGTYPE=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,"")) I MSGTYPE="" Q

 . S DEA=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"DEANumber",0))

 . S NPI=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"NPI",0))

 . S CS=($G(^TMP($J,"PSOERXO1","Message",0,"Header",0,"DigitalSignature",0,"SignatureValue",0))'="")

 . D PRVMTCH^PSOERXA0(.MTCHPROV,NPI,DEA,CS)

 . I +$G(MTCHPROV) D

 . . K PRCHK S PRCHK("success")="true",PRCHK("IEN")=+MTCHPROV

 ;

 ;Auto-Matching Provider

 I $G(PRCHK("success"))="true",PRCHK("IEN") D

 . S FDA(52.49,CURREC,1.2)=1

 . S FDA(52.49,CURREC,2.3)=PRCHK("IEN")

 . ;Auto-Validating Provider if auto-match was successful

 . ;Condition: Non-CS eRx only & Last name, first letter of first name and zip code 5 digits must match

 . S PRVAUTOV=0

 . I '$$GET1^DIQ(52.49,+CURREC,95.1,"I") D

 . . N EPRVIEN,EPRVNAM,EPRVZC,VPRVIEN,VPRVNAM,VPRVZC

 . . S EPRVIEN=$$GET1^DIQ(52.49,+CURREC,2.1,"I")

 . . S EPRVNAM=$$UP^XLFSTR($TR($$GET1^DIQ(52.48,EPRVIEN,.01)," "))

 . . S EPRVZC=$P($$GET1^DIQ(52.48,EPRVIEN,4.5),"-")

 . . S VPRVIEN=PRCHK("IEN") I '$$CHKPRV2^PSOERX1A(VPRVIEN) Q

 . . S VPRVNAM=$$UP^XLFSTR($TR($$GET1^DIQ(200,VPRVIEN,.01)," "))

 . . S VPRVZC=$P($$GET1^DIQ(200,VPRVIEN,.116),"-")

 . . I $E(EPRVNAM,1,$F(EPRVNAM,","))'=$E(VPRVNAM,1,$F(VPRVNAM,",")) Q

 . . I $E(EPRVZC,1,5)'=$E(VPRVZC,1,5) Q

 . . S FDA(52.49,CURREC,1.3)=1

 . . S FDA(52.49,CURREC,1.8)=$$PROXYDUZ^PSOERXUT()

 . . S FDA(52.49,CURREC,1.9)=$$NOW^XLFDT()

 . . S FDA(52.49,CURREC,2.7)=1

 . . S PRVAUTOV=1

 . ;Saving the eRx Audit Log for the Auto-Matched Provider

 . S NEWVAL(1)=$$GET1^DIQ(200,PRCHK("IEN"),.01)_" (DEA#: "_$P($$VADEA^PSOERXU8(PRCHK("IEN"),+CURREC),"^",2)_")"_$S(PRVAUTOV:" - AUTO-VALIDATED",1:"")

 . D AUDLOG^PSOERXUT(+CURREC,"PROVIDER",$$PROXYDUZ^PSOERXUT(),.NEWVAL)

 ;

 I $G(PRCHK("success"))="false" D

 . S ERRTXT=$G(PRCHK("error"))

 . S ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN) Q:'ERRSEQ

 . D FILERR^PSOERXU1(CURREC,ERRSEQ,"PR","E",ERRTXT)

 ;

 I $G(PACHK("MVIerror"))']"" D

 . S PAICN=+$P($G(PACHK("ICN")),"V")

 . I PAICN D

 . . S (PAIEN,PACNT)=0 F  S PAIEN=$O(^DPT("AICN",PAICN,PAIEN)) Q:'PAIEN  D

 . . . S PACNT=PACNT+1

 . . . ;revisit in future build - if we find more than one match in the local system, do we log some sort of an error?

 . I $G(PACNT)=1 D  Q

 . . S FDA(52.49,CURREC,1.6)=1

 . . S FDA(52.49,CURREC,.05)=$O(^DPT("AICN",PAICN,0))

 . I $L(PACHK("ssn")) D

 . . S (PASCNT,PAIEN)=0 F  S PAIEN=$O(^DPT("SSN",$TR(PACHK("ssn"),"-",""),PAIEN)) Q:'PAIEN  D

 . . . S PASCNT=PASCNT+1

 . I $G(PASCNT)=1 D  Q

 . . S FDA(52.49,CURREC,1.6)=1

 . . S FDA(52.49,CURREC,.05)=$O(^DPT("SSN",$TR(PACHK("ssn"),"-",""),0))

 ;

 ;Saving the eRx Audit Log For Auto-Matched Patient

 I $G(FDA(52.49,CURREC,.05)) D

 . N DFN,VADM S DFN=+FDA(52.49,CURREC,.05) D DEM^VADPT

 . S NEWVAL(1)=$$GET1^DIQ(2,DFN,.01)_" (L4SSN: "_$P($P(VADM(2),"^",2),"-",3)_" | DOB: "_$P(VADM(3),"^",2)_")"

 . D AUDLOG^PSOERXUT(+CURREC,"PATIENT",$$PROXYDUZ^PSOERXUT(),.NEWVAL)

 ;

 I $D(FDA) D FILE^DIE(,"FDA") K FDA

 ;

 I $G(PACHK("success"))="false" D

 .; file e&e error

 . S ERRTXT=$G(PACHK("EandEerror")) I ERRTXT]"" D

 . . S ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN) Q:'ERRSEQ

 . . D FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)

 .; file mvi error

 . S ERRTXT=$G(PACHK("MVIerror")) I ERRTXT]"" D

 . . S ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN) Q:'ERRSEQ

 . . D FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)

 ;

 S RES="1^Erx Received."

 ;

 ;Create an Addendum for eRx Change Response Progress Note

 I $G(EIEN)'="",$$GET1^DIQ(52.49,EIEN,.08,"I")="CX" D CREATEADD(ERXHID,EIEN)

 Q

 ;

CREATEADD(ERXHID,EIEN) ;Create CPRS Progress Notes Addendum for this eRx Change Response

 ;Input: ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)^relates to hub ID

 ;       EIEN   - The eRx Change Response IEN, Pointer to ERX HOLDING QUEUE file (#52.49)

 ;Output: Create an Addendum and attach it to the parent eRx Change Request

 ;

 I ($G(ERXHID)="")!($G(EIEN)="") Q

 N CNT,CRERXIEN,ORGERXIEN,ERXDRUG,CRMEDS,CNT,CXTARGET,ERXDRUG,PSOTIUIEN,TIUDADD,ERXTIUX

 ;

 S CRERXIEN=$O(^PS(52.49,"B",$P(ERXHID,"^",3),0))

 S ORGERXIEN=$P($G(^PS(52.49,CRERXIEN,0)),"^",14)

 S ORGERXIEN=$O(^PS(52.49,"B",ORGERXIEN,0))

 ;

 ;get the parent reference IEN TIU Document

 S PSOTIUIEN=$$GET1^DIQ(52.49,CRERXIEN,320.1)

 I '$G(PSOTIUIEN) D  Q

 . D BLDCRMEDS(ERXHID,.DACHK,"ERX RX CHANGE REQUEST NOTE")

 ;

 S CXTARGET=$NA(^TMP("TIUP",$J)) K @CXTARGET

 D BUILDLST^PSOERSE4(CXTARGET,EIEN)

 Q:'$D(@CXTARGET)

 K ERXTIUX M ERXTIUX("TEXT")=@CXTARGET

 D MAKEADD^TIUSRVP2(.TIUDADD,PSOTIUIEN,.ERXTIUX) ;PSOTIUIEN is the parent IEN from The TIU Document Definition name in File #8925.1

 D UPDATEPN^PSOERX1H(.TIUDADD,$G(ORGERXIEN)) ;TIUDADD is the Addendum IEN

 Q

 ;

BLDCRMEDS(ERXHID,DACHK,TIUTITLE) ;Build eRx Change Response Medication array

 ;get the original eRx

 Q:$G(ERXHID)=""

 N CRERXIEN,ORGERXIEN,ERXDRUG,CRMEDS

 ;

 S CRERXIEN=$O(^PS(52.49,"B",$P(ERXHID,"^",3),0))

 S ORGERXIEN=$P($G(^PS(52.49,CRERXIEN,0)),"^",14)

 S ORGERXIEN=$O(^PS(52.49,"B",ORGERXIEN,0))

 S CNT=0

 I $D(DACHK("IEN")) D

 . S ERXDRUG=$$GET1^DIQ(50,DACHK("IEN"),.01)

 . S CNT=CNT+1,CRMEDS(CNT)="^"_ERXDRUG

 ;

 D CREATEPN^PSOERX1H(ORGERXIEN,EIEN,,.CRMEDS,TIUTITLE) ;create eRx Change Response PN

 ;

 Q

 ; VAL - value to resolve

 ; TYPE - This is the code type, which will tell which 'C' index type to get the code from

PRESOLV(VAL,TYPE) ;

 N MATCH

 S MATCH=""

 Q:'$L(TYPE)!('$L(VAL)) "" ; avoid null subscript

 S MATCH=$O(^PS(52.45,"C",TYPE,VAL,0))

 ; return the match found, null if no match

 Q MATCH

CONVDTTM(VAL) ;

 N EDATE,ETIME,X,ETZ,Y

 I '$L(VAL) Q ""

 S EDATE=$P(VAL,"T"),ETIME=$P(VAL,"T",2)

 ; split off time zone

 S ETZ=$P(ETIME,".",2)

 S ETIME=$P(ETIME,".")

 S X=EDATE D ^%DT I 'Y Q ""

 S VAL=Y_$S($L(ETIME):"."_$TR(ETIME,":",""),1:"")

 Q VAL

ERROR ;p783 Error Handling

 D ^%ZTER

 S RES="1^eRx received but there was an error. See error trap at "_$P($TR($$SITE^VASITE(),"^","-"),"-",1,2)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOERXI1   9908     printed  Mar 13, 2025@21:33:26                                                                                                                                                                                                    Page 2

PSOERXI1  ;ALB/BWF - eRx Utilities/RPC's ; 12/10/22 11:24am

 +1       ;;7.0;OUTPATIENT PHARMACY;**581,617,692,706,700,743,746,783**;DEC 1997;Build 1

 +2       ;

 +3       ;

 +4       ;Reference to MAKEADD^TIUSRVP2 in ICR #4795

 +5        QUIT 

 +6       ; File incoming XML into appropriate file

 +7       ; XML - xml text

 +8       ; PRCHK - provider check information

 +9       ; PACHK - patient check information

 +10      ; DACHK - drug auto check

 +11      ; STATION - station #

 +12      ; DIV - institution name^NPI

 +13      ; ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)^relates to hub ID

 +14      ; ERXVALS - code values for NIST codes (potency unit code^form code^strength code^prohibit renewals - change response (y/n))

 +15      ; XML2 - structured sig from the medication prescribed segment

 +16      ; VADAT - DUZ^RXIEN

 +17      ; XML3 - third stream of XML

INCERX(RES,XML,PRCHK,PACHK,DACHK,STATION,DIV,ERXHID,ERXVALS,XML2,VADAT,XML3) ;

 +1       ;p783 This error handling prevents delays at the eRx Hub because it always returns a result

 +2        NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERROR^PSOERXI1"

 +3        NEW CURREC,FDA,EIEN,ERRTXT,ERRSEQ,PACNT,PASCNT,PAICN,PAIEN,VAINST,NPI,VAOI,VPATINST,PRVAUTOV

 +4        SET NPI=$PIECE($GET(DIV),U,2)

 +5        SET CURREC=$$PARSE^PSOERXI2(.XML,.ERXVALS,NPI,.XML2,.XML3)

 +6        IF $PIECE(CURREC,U)<1

               Begin DoDot:1

 +7                IF $LENGTH($PIECE(CURREC,U,2))

                       SET RES=CURREC

                       QUIT 

 +8                SET RES="0^XML received. Error creating or finding associated record in the ERX Holding queue."

                   QUIT 

               End DoDot:1

               QUIT 

 +9        SET EIEN=CURREC

 +10       SET CURREC=CURREC_","

 +11      ;If this is an outbound message, file the users DUZ and quit back the response. no drug, patient, or provider auto checks will occur

 +12       IF $GET(VADAT)]""

               Begin DoDot:1

 +13               IF $PIECE($GET(VADAT),U)>1

                       Begin DoDot:2

 +14                       SET FDA(52.49,CURREC,51.1)=DUZ

                           DO FILE^DIE(,"FDA")

                           KILL FDA

                       End DoDot:2

 +15               IF $PIECE(VADAT,U,2)

                       Begin DoDot:2

 +16                       SET FDA(52.49,CURREC,.13)=$PIECE(VADAT,U,2)

                           DO FILE^DIE(,"FDA")

                           KILL FDA

                       End DoDot:2

 +17               SET RES="1^Erx Received."

               End DoDot:1

               QUIT 

 +18      ;Process auto-validation results. Only log positive results for now

 +19       KILL FDA

 +20       IF $PIECE($GET(VADAT),U)

               SET RES="1^Message Filed."

               QUIT 

 +21      ;

 +22      ;Drug Auto-Check (Moved from Hub to VistA - P-692)

 +23       IF $GET(DACHK("success"))="false"

               Begin DoDot:1

 +24               NEW MSGTYPE,MEDSEG,MTCHDRUG,PRDCODE,PRDCOQL,DRGNAME

 +25               SET MSGTYPE=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,""))

                   IF MSGTYPE=""

                       QUIT 

 +26               SET MEDSEG="MedicationPrescribed"

 +27               IF '$DATA(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG))

                       Begin DoDot:2

 +28                       SET MEDSEG="MedicationResponse"

                       End DoDot:2

 +29               SET PRDCODE=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugCoded",0,"ProductCode",0,"Code",0))

                   IF PRDCODE=""

                       QUIT 

 +30               SET PRDCOQL=$EXTRACT($GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugCoded",0,"ProductCode",0,"Qualifier",0)),1)

 +31               IF PRDCOQL'="N"

                       IF PRDCOQL'="U"

                           QUIT 

 +32               SET DRGNAME=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugDescription",0))

 +33               DO DRGMTCH^PSOERXA0(.MTCHDRUG,PRDCOQL_"^"_PRDCODE,DRGNAME)

 +34               IF +$GET(MTCHDRUG)

                       Begin DoDot:2

 +35                       KILL DACHK

                           SET DACHK("success")="true"

                           SET DACHK("IEN")=+MTCHDRUG

                       End DoDot:2

               End DoDot:1

 +36      ;

 +37       IF $GET(DACHK("success"))="true"

               Begin DoDot:1

 +38               IF $GET(DACHK("IEN"))

                       Begin DoDot:2

 +39      ;Saving the eRx Audit Log For Auto-Matched Drug

 +40                       SET NEWVAL(1)=$$GET1^DIQ(50,DACHK("IEN"),.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(DACHK("IEN"))_")"

 +41                       DO AUDLOG^PSOERXUT(+CURREC,"DRUG",$$PROXYDUZ^PSOERXUT(),.NEWVAL)

 +42      ;Setting Matched Drug and Auto Match info

 +43                       SET FDA(52.49,CURREC,1.4)=1

 +44                       SET FDA(52.49,CURREC,3.2)=DACHK("IEN")

 +45                       SET FDA(52.49,CURREC,44)=1

 +46                       SET VAOI=$$GET1^DIQ(50,DACHK("IEN"),2.1,"I")

 +47                       SET VPATINST=$$GET1^DIQ(50.7,VAOI,7,"E")

 +48                       IF $LENGTH(VPATINST)

                               Begin DoDot:3

 +49                               SET (NEWVAL(1),FDA(52.49,CURREC,27))=VPATINST

 +50                               DO AUDLOG^PSOERXUT(+CURREC,"PATIENT INSTRUCTIONS",$$PROXYDUZ^PSOERXUT(),.NEWVAL)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +51      ;

 +52       IF $GET(DACHK("success"))="false"

               Begin DoDot:1

 +53               SET ERRTXT=$GET(DACHK("error"))

 +54               SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)

                   if 'ERRSEQ

                       QUIT 

 +55               DO FILERR^PSOERXU1(CURREC,ERRSEQ,"D","E",ERRTXT)

               End DoDot:1

 +56      ;

 +57      ;Provider Auto-Check (Moved from Hub to VistA - P-692)

 +58       IF $GET(PRCHK("success"))="false"

               Begin DoDot:1

 +59               NEW TMP,MSGTYPE,MTCHPROV,TMP,NPI,DEA,CS

 +60               SET MSGTYPE=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,""))

                   IF MSGTYPE=""

                       QUIT 

 +61               SET DEA=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"DEANumber",0))

 +62               SET NPI=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"NPI",0))

 +63               SET CS=($GET(^TMP($JOB,"PSOERXO1","Message",0,"Header",0,"DigitalSignature",0,"SignatureValue",0))'="")

 +64               DO PRVMTCH^PSOERXA0(.MTCHPROV,NPI,DEA,CS)

 +65               IF +$GET(MTCHPROV)

                       Begin DoDot:2

 +66                       KILL PRCHK

                           SET PRCHK("success")="true"

                           SET PRCHK("IEN")=+MTCHPROV

                       End DoDot:2

               End DoDot:1

 +67      ;

 +68      ;Auto-Matching Provider

 +69       IF $GET(PRCHK("success"))="true"

               IF PRCHK("IEN")

                   Begin DoDot:1

 +70                   SET FDA(52.49,CURREC,1.2)=1

 +71                   SET FDA(52.49,CURREC,2.3)=PRCHK("IEN")

 +72      ;Auto-Validating Provider if auto-match was successful

 +73      ;Condition: Non-CS eRx only & Last name, first letter of first name and zip code 5 digits must match

 +74                   SET PRVAUTOV=0

 +75                   IF '$$GET1^DIQ(52.49,+CURREC,95.1,"I")

                           Begin DoDot:2

 +76                           NEW EPRVIEN,EPRVNAM,EPRVZC,VPRVIEN,VPRVNAM,VPRVZC

 +77                           SET EPRVIEN=$$GET1^DIQ(52.49,+CURREC,2.1,"I")

 +78                           SET EPRVNAM=$$UP^XLFSTR($TRANSLATE($$GET1^DIQ(52.48,EPRVIEN,.01)," "))

 +79                           SET EPRVZC=$PIECE($$GET1^DIQ(52.48,EPRVIEN,4.5),"-")

 +80                           SET VPRVIEN=PRCHK("IEN")

                               IF '$$CHKPRV2^PSOERX1A(VPRVIEN)

                                   QUIT 

 +81                           SET VPRVNAM=$$UP^XLFSTR($TRANSLATE($$GET1^DIQ(200,VPRVIEN,.01)," "))

 +82                           SET VPRVZC=$PIECE($$GET1^DIQ(200,VPRVIEN,.116),"-")

 +83                           IF $EXTRACT(EPRVNAM,1,$FIND(EPRVNAM,","))'=$EXTRACT(VPRVNAM,1,$FIND(VPRVNAM,","))

                                   QUIT 

 +84                           IF $EXTRACT(EPRVZC,1,5)'=$EXTRACT(VPRVZC,1,5)

                                   QUIT 

 +85                           SET FDA(52.49,CURREC,1.3)=1

 +86                           SET FDA(52.49,CURREC,1.8)=$$PROXYDUZ^PSOERXUT()

 +87                           SET FDA(52.49,CURREC,1.9)=$$NOW^XLFDT()

 +88                           SET FDA(52.49,CURREC,2.7)=1

 +89                           SET PRVAUTOV=1

                           End DoDot:2

 +90      ;Saving the eRx Audit Log for the Auto-Matched Provider

 +91                   SET NEWVAL(1)=$$GET1^DIQ(200,PRCHK("IEN"),.01)_" (DEA#: "_$PIECE($$VADEA^PSOERXU8(PRCHK("IEN"),+CURREC),"^",2)_")"_$SELECT(PRVAUTOV:" - AUTO-VALIDATED",1:"")

 +92                   DO AUDLOG^PSOERXUT(+CURREC,"PROVIDER",$$PROXYDUZ^PSOERXUT(),.NEWVAL)

                   End DoDot:1

 +93      ;

 +94       IF $GET(PRCHK("success"))="false"

               Begin DoDot:1

 +95               SET ERRTXT=$GET(PRCHK("error"))

 +96               SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)

                   if 'ERRSEQ

                       QUIT 

 +97               DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PR","E",ERRTXT)

               End DoDot:1

 +98      ;

 +99       IF $GET(PACHK("MVIerror"))']""

               Begin DoDot:1

 +100              SET PAICN=+$PIECE($GET(PACHK("ICN")),"V")

 +101              IF PAICN

                       Begin DoDot:2

 +102                      SET (PAIEN,PACNT)=0

                           FOR 

                               SET PAIEN=$ORDER(^DPT("AICN",PAICN,PAIEN))

                               if 'PAIEN

                                   QUIT 

                               Begin DoDot:3

 +103                              SET PACNT=PACNT+1

 +104     ;revisit in future build - if we find more than one match in the local system, do we log some sort of an error?

                               End DoDot:3

                       End DoDot:2

 +105              IF $GET(PACNT)=1

                       Begin DoDot:2

 +106                      SET FDA(52.49,CURREC,1.6)=1

 +107                      SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("AICN",PAICN,0))

                       End DoDot:2

                       QUIT 

 +108              IF $LENGTH(PACHK("ssn"))

                       Begin DoDot:2

 +109                      SET (PASCNT,PAIEN)=0

                           FOR 

                               SET PAIEN=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),PAIEN))

                               if 'PAIEN

                                   QUIT 

                               Begin DoDot:3

 +110                              SET PASCNT=PASCNT+1

                               End DoDot:3

                       End DoDot:2

 +111              IF $GET(PASCNT)=1

                       Begin DoDot:2

 +112                      SET FDA(52.49,CURREC,1.6)=1

 +113                      SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),0))

                       End DoDot:2

                       QUIT 

               End DoDot:1

 +114     ;

 +115     ;Saving the eRx Audit Log For Auto-Matched Patient

 +116      IF $GET(FDA(52.49,CURREC,.05))

               Begin DoDot:1

 +117              NEW DFN,VADM

                   SET DFN=+FDA(52.49,CURREC,.05)

                   DO DEM^VADPT

 +118              SET NEWVAL(1)=$$GET1^DIQ(2,DFN,.01)_" (L4SSN: "_$PIECE($PIECE(VADM(2),"^",2),"-",3)_" | DOB: "_$PIECE(VADM(3),"^",2)_")"

 +119              DO AUDLOG^PSOERXUT(+CURREC,"PATIENT",$$PROXYDUZ^PSOERXUT(),.NEWVAL)

               End DoDot:1

 +120     ;

 +121      IF $DATA(FDA)

               DO FILE^DIE(,"FDA")

               KILL FDA

 +122     ;

 +123      IF $GET(PACHK("success"))="false"

               Begin DoDot:1

 +124     ; file e&e error

 +125              SET ERRTXT=$GET(PACHK("EandEerror"))

                   IF ERRTXT]""

                       Begin DoDot:2

 +126                      SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)

                           if 'ERRSEQ

                               QUIT 

 +127                      DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)

                       End DoDot:2

 +128     ; file mvi error

 +129              SET ERRTXT=$GET(PACHK("MVIerror"))

                   IF ERRTXT]""

                       Begin DoDot:2

 +130                      SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)

                           if 'ERRSEQ

                               QUIT 

 +131                      DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)

                       End DoDot:2

               End DoDot:1

 +132     ;

 +133      SET RES="1^Erx Received."

 +134     ;

 +135     ;Create an Addendum for eRx Change Response Progress Note

 +136      IF $GET(EIEN)'=""

               IF $$GET1^DIQ(52.49,EIEN,.08,"I")="CX"

                   DO CREATEADD(ERXHID,EIEN)

 +137      QUIT 

 +138     ;

CREATEADD(ERXHID,EIEN) ;Create CPRS Progress Notes Addendum for this eRx Change Response

 +1       ;Input: ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)^relates to hub ID

 +2       ;       EIEN   - The eRx Change Response IEN, Pointer to ERX HOLDING QUEUE file (#52.49)

 +3       ;Output: Create an Addendum and attach it to the parent eRx Change Request

 +4       ;

 +5        IF ($GET(ERXHID)="")!($GET(EIEN)="")

               QUIT 

 +6        NEW CNT,CRERXIEN,ORGERXIEN,ERXDRUG,CRMEDS,CNT,CXTARGET,ERXDRUG,PSOTIUIEN,TIUDADD,ERXTIUX

 +7       ;

 +8        SET CRERXIEN=$ORDER(^PS(52.49,"B",$PIECE(ERXHID,"^",3),0))

 +9        SET ORGERXIEN=$PIECE($GET(^PS(52.49,CRERXIEN,0)),"^",14)

 +10       SET ORGERXIEN=$ORDER(^PS(52.49,"B",ORGERXIEN,0))

 +11      ;

 +12      ;get the parent reference IEN TIU Document

 +13       SET PSOTIUIEN=$$GET1^DIQ(52.49,CRERXIEN,320.1)

 +14       IF '$GET(PSOTIUIEN)

               Begin DoDot:1

 +15               DO BLDCRMEDS(ERXHID,.DACHK,"ERX RX CHANGE REQUEST NOTE")

               End DoDot:1

               QUIT 

 +16      ;

 +17       SET CXTARGET=$NAME(^TMP("TIUP",$JOB))

           KILL @CXTARGET

 +18       DO BUILDLST^PSOERSE4(CXTARGET,EIEN)

 +19       if '$DATA(@CXTARGET)

               QUIT 

 +20       KILL ERXTIUX

           MERGE ERXTIUX("TEXT")=@CXTARGET

 +21      ;PSOTIUIEN is the parent IEN from The TIU Document Definition name in File #8925.1

           DO MAKEADD^TIUSRVP2(.TIUDADD,PSOTIUIEN,.ERXTIUX)

 +22      ;TIUDADD is the Addendum IEN

           DO UPDATEPN^PSOERX1H(.TIUDADD,$GET(ORGERXIEN))

 +23       QUIT 

 +24      ;

BLDCRMEDS(ERXHID,DACHK,TIUTITLE) ;Build eRx Change Response Medication array

 +1       ;get the original eRx

 +2        if $GET(ERXHID)=""

               QUIT 

 +3        NEW CRERXIEN,ORGERXIEN,ERXDRUG,CRMEDS

 +4       ;

 +5        SET CRERXIEN=$ORDER(^PS(52.49,"B",$PIECE(ERXHID,"^",3),0))

 +6        SET ORGERXIEN=$PIECE($GET(^PS(52.49,CRERXIEN,0)),"^",14)

 +7        SET ORGERXIEN=$ORDER(^PS(52.49,"B",ORGERXIEN,0))

 +8        SET CNT=0

 +9        IF $DATA(DACHK("IEN"))

               Begin DoDot:1

 +10               SET ERXDRUG=$$GET1^DIQ(50,DACHK("IEN"),.01)

 +11               SET CNT=CNT+1

                   SET CRMEDS(CNT)="^"_ERXDRUG

               End DoDot:1

 +12      ;

 +13      ;create eRx Change Response PN

           DO CREATEPN^PSOERX1H(ORGERXIEN,EIEN,,.CRMEDS,TIUTITLE)

 +14      ;

 +15       QUIT 

 +16      ; VAL - value to resolve

 +17      ; TYPE - This is the code type, which will tell which 'C' index type to get the code from

PRESOLV(VAL,TYPE) ;

 +1        NEW MATCH

 +2        SET MATCH=""

 +3       ; avoid null subscript

           if '$LENGTH(TYPE)!('$LENGTH(VAL))

               QUIT ""

 +4        SET MATCH=$ORDER(^PS(52.45,"C",TYPE,VAL,0))

 +5       ; return the match found, null if no match

 +6        QUIT MATCH

CONVDTTM(VAL) ;

 +1        NEW EDATE,ETIME,X,ETZ,Y

 +2        IF '$LENGTH(VAL)

               QUIT ""

 +3        SET EDATE=$PIECE(VAL,"T")

           SET ETIME=$PIECE(VAL,"T",2)

 +4       ; split off time zone

 +5        SET ETZ=$PIECE(ETIME,".",2)

 +6        SET ETIME=$PIECE(ETIME,".")

 +7        SET X=EDATE

           DO ^%DT

           IF 'Y

               QUIT ""

 +8        SET VAL=Y_$SELECT($LENGTH(ETIME):"."_$TRANSLATE(ETIME,":",""),1:"")

 +9        QUIT VAL

ERROR     ;p783 Error Handling

 +1        DO ^%ZTER

 +2        SET RES="1^eRx received but there was an error. See error trap at "_$PIECE($TRANSLATE($$SITE^VASITE(),"^","-"),"-",1,2)

 +3        QUIT