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

PSOERXA3.m

Go to the documentation of this file.
  1. PSOERXA3 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**467,508,617**;DEC 1997;Build 110
  1. ;
  1. Q
  1. HDR(MTYPE) ; header information
  1. N GL,GL2,FQUAL,TQUAL,FROM,TO,MID,PONUM,SRTID,SSTID,SENTTIME,RTMID,FDA,ERXIEN,FMID,NEWERX,MES,ERXIENS,SSSID,SRSID,MTVALS
  1. N UPMTYPE,DONE,I,ERXISTAT,MTCODE,COMPSTR,RTHID,RTHIEN,RTMIEN,SIGVAL,X509DATA
  1. S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Header",0))
  1. S GL2=$NA(^TMP($J,"PSOERXO1","Message","A","Qualifier","Header","A","Qualifier"))
  1. ; from and to qualifiers
  1. S FQUAL=$G(@GL2@("From","A","Qualifier"))
  1. S TQUAL=$G(@GL2@("To","A","Qualifier"))
  1. ; from, to, message id, prescriber order number
  1. S FROM=$G(@GL@("From",0))
  1. S TO=$G(@GL@("To",0))
  1. S MID=$G(@GL@("MessageID",0))
  1. ; set up the full message id
  1. S FMID=MID
  1. S ERXIENS="+1,"
  1. ; quit and return a message back if this eRx exists.
  1. I $D(^PS(52.49,"FMID",$P(ERXHID,U))) D Q MES
  1. .S MES="0^This message already exists. Changes must occur via a change request XML message."
  1. S PONUM=$G(@GL@("PrescriberOrderNumber",0))
  1. ; security receiver tertiary identification
  1. S SRSID=$G(@GL@("Security",0,"Receiver",0,"SecondaryIdentification",0))
  1. S SRTID=$G(@GL@("Security",0,"Receiver",0,"TertiaryIdentification,",0))
  1. ; security sender tertiary identification
  1. S SSSID=$G(@GL@("Security",0,"Sender",0,"SecondaryIdentification",0))
  1. S SSTID=$G(@GL@("Security",0,"Sender",0,"TertiaryIdentification,",0))
  1. ; convert senttime to file manager dt/tm
  1. S SENTTIME=$G(@GL@("SentTime",0)),SENTTIME=$$CONVDTTM^PSOERXA1(SENTTIME)
  1. S RTMID=$G(@GL@("RelatesToMessageID",0))
  1. S RTHID=$P(ERXHID,U,3)
  1. S RTHIEN=""
  1. I $L(RTHID) S RTHIEN=$O(^PS(52.49,"FMID",RTHID,0))
  1. D FIELD^DID(52.49,.08,"","POINTER","MTVALS")
  1. S UPMTYPE=$$UP^XLFSTR(MTYPE)
  1. I UPMTYPE="REFILLREQUEST" S UPMTYPE="RXRENEWALREQUEST"
  1. S DONE=0
  1. F I=1:1 D Q:DONE
  1. .S COMPSTR=$P(MTVALS("POINTER"),";",I)
  1. .I COMPSTR="" S DONE=1 Q
  1. .I COMPSTR[UPMTYPE S MTCODE=$P(COMPSTR,":"),DONE=1
  1. I $G(MTCODE)']"" Q "0^Message type could not be resolved."
  1. S FDA(52.49,ERXIENS,.08)=MTCODE
  1. ; erx hub message id
  1. S FDA(52.49,ERXIENS,.01)=$P(ERXHID,U)
  1. ; change healthcare message id
  1. S FDA(52.49,ERXIENS,25)=FMID
  1. S FDA(52.49,ERXIENS,.02)=RTMID
  1. S FDA(52.49,ERXIENS,.03)=$$NOW^XLFDT
  1. S FDA(52.49,ERXIENS,.09)=PONUM
  1. ;RELATES TO HUB ID
  1. S FDA(52.49,ERXIENS,.14)=RTHID
  1. S ERXISTAT=$$GETSTAT^PSOERXU2(MTCODE,RTHIEN,RTMID)
  1. S FDA(52.49,ERXIENS,1)=ERXISTAT
  1. S FDA(52.49,ERXIENS,22.1)=FROM
  1. S FDA(52.49,ERXIENS,22.2)=FQUAL
  1. S FDA(52.49,ERXIENS,22.3)=TO
  1. S FDA(52.49,ERXIENS,22.4)=TQUAL
  1. S FDA(52.49,ERXIENS,22.5)=SENTTIME
  1. S FDA(52.49,ERXIENS,24.3)=SSSID
  1. S FDA(52.49,ERXIENS,24.4)=SSTID
  1. S FDA(52.49,ERXIENS,24.5)=SRSID
  1. S FDA(52.49,ERXIENS,24.6)=SRTID
  1. ; Controlled Substance eRx
  1. S FDA(52.49,ERXIENS,95.1)=$$CSERX^PSOERXA1()
  1. I $$CSERX^PSOERXA1() D
  1. . S FDA(52.49,ERXIENS,95.2)=$G(@GL@("DigitalSignature",0,"DigestMethod",0))
  1. . S FDA(52.49,ERXIENS,95.3)=$G(@GL@("DigitalSignature",0,"DigestValue",0))
  1. . K SIGVAL S SIGVAL(1)=$G(@GL@("DigitalSignature",0,"SignatureValue",0))
  1. . S FDA(52.49,ERXIENS,95.4)="SIGVAL"
  1. . K X509DAT S X509DAT(1)=$G(@GL@("DigitalSignature",0,"X509Data",0))
  1. . S FDA(52.49,ERXIENS,95.5)="X509DAT"
  1. ; if this is an existing record, file the updates to the erx and return the IEN
  1. D UPDATE^DIE(,"FDA","NEWERX","EERR") K FDA
  1. S ERXIEN=""
  1. S ERXIEN=$O(NEWERX(0)),ERXIEN=$G(NEWERX(ERXIEN))
  1. I 'ERXIEN Q ""
  1. I $G(RTHIEN)]"" D
  1. .N REFREQ,NRXIEN
  1. .S NRXIEN=$$FINDNRX^PSOERXU6(ERXIEN)
  1. .I MTCODE="RE" D
  1. ..S REFREQ=$$GETREQ^PSOERXU2(ERXIEN)
  1. ..I REFREQ S NRXIEN=$$FINDNRX^PSOERXU6(REFREQ)
  1. ..I $D(^PS(52.49,NRXIEN,201,"B",ERXIEN)) Q
  1. ..I $G(NRXIEN) S FDA2(52.49201,"+1,"_NRXIEN_",",.01)=ERXIEN D UPDATE^DIE(,"FDA2") K FDA2
  1. .; link this message to the original
  1. .I $G(NRXIEN) D
  1. ..I $D(^PS(52.49,NRXIEN,201,"B",ERXIEN)) Q
  1. ..S FDA2(52.49201,"+1,"_NRXIEN_",",.01)=ERXIEN D UPDATE^DIE(,"FDA2") K FDA2
  1. .I '$D(^PS(52.49,RTHIEN,201,"B",ERXIEN)) D
  1. ..S FDA2(52.49201,"+1,"_RTHIEN_",",.01)=ERXIEN D UPDATE^DIE(,"FDA2") K FDA2
  1. .; link original message to this erxien
  1. .I '$D(^PS(52.49,ERXIEN,201,"B",RTHIEN)) D
  1. ..S FDA2(52.49201,"+1,"_ERXIEN_",",.01)=RTHIEN D UPDATE^DIE(,"FDA2") K FDA2
  1. I MTYPE["Error" D ERR^PSOERXU2(ERXIEN,MTYPE)
  1. ; Future consideration - XSD shows digital signature. Do we need to collect this?
  1. Q ERXIEN
  1. ;
  1. MED(ERXIEN,ERXVALS,MTYPE) ; medication prescribed
  1. N GL,VALDT,DAYS,CIQUAL,PQUAL,PDIAG,SQUAL,DIAG,SDIAG,DIRECT,DCSTAT,DCSCODE,DDESC,DUE,CAID,CAQUAL,PSC,SREACODE,SRESCODE
  1. N EFFDT,EXPDT,NOTE,PEDT,PAUTHQ,PAUTHV,PAUTHS,QCLQ,QPUC,QUSC,QTY,REFQUAL,REFILLS,WRITDT,SUBS,STOPIND,CLINSIG,ACKREA
  1. N F,EIENS,SFDA,FDA,DIENS,DCCNT,VALDATE,DCDBCOD,DCDBCODQ,DCDEASCH,DCFC,DCFSC,DCPCODE,DCPCQUAL,DCSTR,DCSTRC,DCSTSC,GL2
  1. N DONOTFIL
  1. I 'ERXIEN Q
  1. S EIENS=ERXIEN_","
  1. S F=52.49
  1. S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"MedicationPrescribed",0))
  1. S GL2=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"MedicationDispensed",0))
  1. S VALDT=$G(@GL@("DateValidated",0,"Date",0)),VALDATE=$$CONVDTTM^PSOERXA1(VALDT),FDA(52.49,EIENS,6.6)=VALDATE
  1. S DAYS=$G(@GL@("DaysSupply",0)) I DAYS S FDA(F,EIENS,5.5)=+$G(DAYS)
  1. ; force to numeric
  1. I +$G(DAYS)<366 S FDA(F,EIENS,20.2)=+$G(DAYS)
  1. S FDA(F,EIENS,20.4)="M"
  1. S DIRECT=$G(@GL@("Directions",0)),FDA(F,EIENS,7)=DIRECT
  1. S DDESC=$$UP^XLFSTR($G(@GL@("DrugDescription",0))),FDA(52.49,EIENS,3.1)=DDESC
  1. ; drugCoded
  1. S DCPCODE=$G(@GL@("DrugCoded",0,"ProductCode",0)),FDA(F,EIENS,4.1)=DCPCODE
  1. S DCPCQUAL=$G(@GL@("DrugCoded",0,"ProductCodeQualifier",0)),FDA(F,EIENS,4.2)=DCPCQUAL
  1. S DCSTR=$G(@GL@("DrugCoded",0,"Strength",0)),FDA(F,EIENS,4.3)=DCSTR
  1. S DCDBCOD=$G(@GL@("DrugCoded",0,"DrugDBCode",0)),FDA(F,EIENS,4.4)=DCDBCOD
  1. S DCDBCODQ=$G(@GL@("DrugCoded",0,"DrugDBCodeQualifier",0)),FDA(F,EIENS,4.11)=$$PRESOLV^PSOERXA1(DCDBCODQ,"DDB")
  1. S DCFSC=$G(@GL@("DrugCoded",0,"FormSourceCode",0)),FDA(F,EIENS,4.5)=DCFSC
  1. S DCFC=$G(@GL@("DrugCoded",0,"FormCode",0)),FDA(F,EIENS,4.6)=DCFC
  1. S DCSTSC=$G(@GL@("DrugCoded",0,"StrengthSourceCode",0)),FDA(F,EIENS,4.7)=DCSTSC
  1. S DCSTRC=$G(@GL@("DrugCoded",0,"StrengthCode",0)),FDA(F,EIENS,4.8)=DCSTRC
  1. S DCDEASCH=$G(@GL@("DrugCoded",0,"DEASchedule",0)),FDA(F,EIENS,4.9)=DCDEASCH
  1. ; end drugCoded
  1. S EFFDT=$G(@GL@("EffectiveDate",0,"Date",0))
  1. I EFFDT="" S EFFDT=$G(@GL@("EffectiveDate",0,"DateTime",0))
  1. S EFFDT=$$CONVDTTM^PSOERXA1(EFFDT),FDA(F,EIENS,6.3)=EFFDT
  1. S EXPDT=$G(@GL@("ExpirationDate",0,"Date",0))
  1. I EXPDT="" S EXPDT=$G(@GL@("ExpirationDate",0,"DateTime",0))
  1. S EXPDT=$$CONVDTTM^PSOERXA1(EXPDT),FDA(F,EIENS,6.2)=EXPDT
  1. S NOTE=$G(@GL@("Note",0)),FDA(F,EIENS,8)=NOTE
  1. ; Future enhancement - no place to store period end date as of now, add in the future if needed
  1. S PEDT=$G(@GL@("PeriodEnd",0,"Date",0))
  1. I PEDT="" S PEDT=$G(@GL@("PeriodEnd",0,"DateTime",0))
  1. S PEDT=$$CONVDTTM^PSOERXA1(PEDT),FDA(F,EIENS,6.4)=PEDT
  1. S WRITDT=$G(@GL@("WrittenDate",0,"Date",0))
  1. I WRITDT="" S WRITDT=$G(@GL@("WrittenDate",0,"DateTime",0))
  1. S WRITDT=$$CONVDTTM^PSOERXA1(WRITDT),FDA(F,EIENS,5.9)=WRITDT
  1. ;DoNotFill Indicator
  1. S DONOTFIL=$G(@GL@("DoNotFill",0)) I $G(DONOTFIL)'="" S FDA(F,EIENS,10.5)=$S(DONOTFIL="Y":1,DONOTFIL="E":2,DONOTFIL="H":3,1:"")
  1. ; dispense notes
  1. S SUBS=$G(@GL@("Substitutions",0)),FDA(F,EIENS,5.8)=SUBS
  1. ; Future enhancement - store stop indicator
  1. ;S STOPIND=$G(@GL@("Stop",0,"StopIndicator",0)),FDA(F,EIENS,12.7)=STOPIND
  1. ; prior authorization
  1. S PAUTHQ=$G(@GL@("PriorAuthorization",0,"Qualifier",0)),PAUTHQ=$$PRESOLV^PSOERXA1(PAUTHQ,"PAV"),FDA(F,EIENS,10.3)=PAUTHQ
  1. S PAUTHV=$G(@GL@("PriorAuthorization",0,"Value",0)),FDA(F,EIENS,10.2)=PAUTHV
  1. S PAUTHS=$G(@GL@("PriorAuthorizationStatus",0)),FDA(F,EIENS,10.4)=PAUTHS
  1. ; quantity
  1. S QCLQ=$G(@GL@("Quantity",0,"CodeListQualifier",0)),FDA(F,EIENS,5.2)=QCLQ
  1. S QPUC=$G(@GL@("Quantity",0,"PotencyUnitCode",0)),FDA(F,EIENS,5.4)=QPUC
  1. S QUSC=$G(@GL@("Quantity",0,"UnitSourceCode",0)),FDA(F,EIENS,5.3)=QUSC
  1. S QTY=$G(@GL@("Quantity",0,"Value",0)),FDA(F,EIENS,5.1)=QTY
  1. ; future consideration:
  1. ; need to look into quantity multiplier on the VA side of things. It looks like the
  1. ; ncpdp quantity multiplier is for billing purposes only.
  1. I $L($P(QTY,".",2))<3 S FDA(F,EIENS,20.1)=QTY
  1. ; refills
  1. S REFQUAL=$G(@GL@("Refills",0,"Qualifier",0)),FDA(F,EIENS,5.7)=REFQUAL
  1. S REFILLS=$G(@GL@("Refills",0,"Value",0))
  1. S FDA(F,EIENS,5.6)=REFILLS
  1. ; ensure vista refills can be exacly what is passed in, as long as it is not greater than 11
  1. I REFILLS<12 S FDA(F,EIENS,20.5)=REFILLS
  1. S FDA(F,EIENS,20.4)="M"
  1. S FDA(F,EIENS,41)=$P($G(ERXVALS("FormCode")),U,2)
  1. S FDA(F,EIENS,42)=$P($G(ERXVALS("PotencyUnitCode")),U,2)
  1. S FDA(F,EIENS,43)=$P($G(ERXVALS("StrengthCode")),U,2)
  1. ; file what we currently have
  1. D FILE^DIE(,"FDA") K FDA
  1. ; diagnosis - primary and secondary
  1. N DIAGCNT,STORCODE,DIAFDA
  1. S DIAGCNT=0
  1. S DIAG=-1 F S DIAG=$O(@GL@("Diagnosis",DIAG)) Q:DIAG="" D
  1. .S DIAGCNT=DIAGCNT+1
  1. .S DIENS="+"_DIAGCNT_","_EIENS
  1. .S CIQUAL=$G(@GL@("Diagnosis",DIAG,"ClinicalInformationQualifier",0))
  1. .S PQUAL=$G(@GL@("Diagnosis",DIAG,"Primary",0,"Qualifier",0))
  1. .S PDIAG=$G(@GL@("Diagnosis",DIAG,"Primary",0,"Value",0))
  1. .S SQUAL=$G(@GL@("Diagnosis",DIAG,"Secondary",0,"Qualifier",0))
  1. .S SDIAG=$G(@GL@("Diagnosis",DIAG,"Secondary",0,"Value",0))
  1. .S DIAFDA(52.499,"+1,"_EIENS,.01)=DIAGCNT,DIAFDA(52.499,"+1,"_EIENS,.02)=CIQUAL
  1. .S DIAFDA(52.499,"+1,"_EIENS,.03)=PQUAL,DIAFDA(52.499,"+1,"_EIENS,.04)=PDIAG
  1. .S DIAFDA(52.499,"+1,"_EIENS,.05)=SQUAL,DIAFDA(52.499,"+1,"_EIENS,.06)=SDIAG
  1. .D UPDATE^DIE(,"DIAFDA") K DIAFDA
  1. ; drug coverage status codes
  1. S DCCNT=0
  1. S DCSTAT=-1 F S DCSTAT=$O(@GL@("DrugCoverageStatusCode",DCSTAT)) Q:DCSTAT="" D
  1. .S DCSCODE=$G(@GL@("DrugCoverageStatusCode",DCSTAT))
  1. .S STORCODE=$$PRESOLV^PSOERXA1(DCSCODE,"DCS") Q:'$L(STORCODE)
  1. .S DCCNT=DCCNT+1
  1. .S DCFDA(52.4928,"+1,"_EIENS,.01)=DCCNT
  1. .S DCFDA(52.4928,"+1,"_EIENS,.02)=STORCODE D UPDATE^DIE(,"DCFDA") K DCFDA
  1. ; if the service reason code (.01) be the same value more than once, convert the .01 field to a sequence
  1. S DUE=-1 F S DUE=$O(@GL@("DrugUseEvaluation",DUE)) Q:DUE="" D
  1. .S CAID=$G(@GL@("DrugUseEvaluation",DUE,"CoAgent",0,"CoAgentID",0)),DUEFDA(52.4916,"+1,"_EIENS,.04)=CAID
  1. .S CAQUAL=$G(@GL@("DrugUseEvaluation",DUE,"CoAgent",0,"CoAgentQualifier",0)),CAQUAL=$$PRESOLV^PSOERXA1(CAQUAL,"CAQ"),DUEFDA(52.4916,"+1,"_EIENS,.05)=CAQUAL
  1. .S PSC=$G(@GL@("DrugUseEvaluation",DUE,"ProfessionalServiceCode",0)),PSC=$$PRESOLV^PSOERXA1(PSC,"PSC"),DUEFDA(52.4916,"+1,"_EIENS,.02)=PSC
  1. .S SREACODE=$G(@GL@("DrugUseEvaluation",DUE,"ServiceReasonCode",0)),SREACODE=$$PRESOLV^PSOERXA1(SREACODE,"REA"),DUEFDA(52.4916,"+1,"_EIENS,.01)=SREACODE
  1. .S SRESCODE=$G(@GL@("DrugUseEvaluation",DUE,"ServiceResultCode",0)),SRESCODE=$$PRESOLV^PSOERXA1(SRESCODE,"RES"),DUEFDA(52.4916,"+1,"_EIENS,.03)=SRESCODE
  1. .S CLINSIG=$G(@GL@("DrugUseEvaluation",DUE,"ClinicalSignificanceCode",0)),DUEFDA(52.4916,"+1,"_EIENS,.06)=CLINSIG
  1. .S ACKREA=$G(@GL@("DrugUseEvaluation",DUE,"AcknowledgementReason",0)),DUEFDA(52.4916,"+1,"_EIENS,1)=ACKREA
  1. .D UPDATE^DIE(,"DUEFDA") K DUEFDA
  1. D SS^PSOERXA4(EIENS)
  1. Q