PSOERXA1 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
;;7.0;OUTPATIENT PHARMACY;**467,520,508,551,581,617**;DEC 1997;Build 110
;
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)
; ERXVALS - code values for NIST codes
; XML2 - structured sig from the medication prescribed segment
; VADAT - DUZ^RXIEN
INCERX(RES,XML,PRCHK,PACHK,DACHK,STATION,DIV,ERXHID,ERXVALS,XML2,VADAT) ;
N CURREC,FDA,EIEN,ERRTXT,ERRSEQ,PACNT,PASCNT,PAICN,PAIEN,VAINST,NPI,VAOI,VPATINST,NEWVAL
S NPI=$P($G(DIV),U,2)
S CURREC=$$PARSE(.XML,.ERXVALS,NPI,.XML2)
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 $D(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
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) S FDA(52.49,CURREC,27)=VPATINST
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)
I $G(PRCHK("success"))="true" D
.I PRCHK("IEN") D
..S FDA(52.49,CURREC,1.2)=1
..S FDA(52.49,CURREC,2.3)=PRCHK("IEN")
..;Saving the eRx Audit Log for the Auto-Matched Provider
..S NEWVAL(1)=$$GET1^DIQ(200,PRCHK("IEN"),.01)_" (DEA#: "_$$DEA^XUSER(0,PRCHK("IEN"))_")"
..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))
I $D(FDA) D FILE^DIE(,"FDA") K FDA
;
;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."
Q
PARSE(STREAM,ERXVALS,NPI,STREAM2) ;
N %XML,GL,VAINST,MTYPE,HUBDENY
S GL=$NA(^TMP($J,"PSOERXO1"))
K @GL
N STATUS,READER,XOBERR,S,ATTR,READER2,XOBERR2,STATUS2
S STREAM=$TR(STREAM,"^","")
I $L(STREAM2) S STREAM2=$TR(STREAM2,"^","")
S STATUS=##class(%XML.TextReader).ParseStream(STREAM,.READER,,,,,1)
I $L(STREAM2) S STATUS2=##class(%XML.TextReader).ParseStream(STREAM2,.READER2,,,,,1)
I $$STATCHK^XOBWLIB(STATUS,.XOBERR,1) D
.N BREAK
.S BREAK=0 F Q:BREAK||READER.EOF||'READER.Read() D
..N X,PUSHED,PARENT
..I READER.AttributeCount D
...S PARENT=READER.LocalName
...D SPUSH(.S,PARENT) S PUSHED=1
...F ATTR=1:1:READER.AttributeCount D
....D READER.MoveToAttributeIndex(ATTR)
....I READER.NodeType="attribute" D APUT(.S,READER.Value,READER.LocalName)
..I READER.NodeType="element",'$G(PUSHED) D SPUSH(.S,READER.LocalName)
..; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
..I READER.NodeType="element",READER.IsEmptyElement D SPUT(.S,"")
..I READER.NodeType="endelement" D SPOP(.S,.X)
..I READER.NodeType="chars" D SPUT(.S,READER.Value)
I $D(STATUS2) D
.I $$STATCHK^XOBWLIB(STATUS2,.XOBERR2,1) D
..N BREAK,S
..S BREAK=0 F Q:BREAK||READER2.EOF||'READER2.Read() D
...N X,PUSHED,PARENT
...I READER2.AttributeCount D
....S PARENT=READER2.LocalName
....D SPUSH(.S,PARENT) S PUSHED=1
....F ATTR=1:1:READER2.AttributeCount D
.....D READER2.MoveToAttributeIndex(ATTR)
.....I READER2.NodeType="attribute" D APUT(.S,READER2.Value,READER2.LocalName)
...I READER2.NodeType="element",'$G(PUSHED) D SPUSH(.S,READER2.LocalName)
...; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
...I READER.NodeType="element",READER.IsEmptyElement D SPUT(.S,"")
...I READER2.NodeType="endelement" D SPOP(.S,.X)
...I READER2.NodeType="chars" D SPUT(.S,READER2.Value)
S MTYPE=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,"")) Q:MTYPE']"" "0^Message type could not be identified."
I '$L(NPI) S NPI=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Identification",0,"NPI",0))
I '$L(NPI) Q "0^Missing NPI. Institution could not be resolved. eRx not filed."
S VAINST=$$FIND1^DIC(4,,"O",NPI,"ANPI")
I '$G(VAINST) Q "0^Institution could not be resolved. eRx not filed."
N NERXIEN,ERR,PATIEN
S NERXIEN=$$HDR^PSOERXA3(MTYPE)
I $P(NERXIEN,U)<1 Q NERXIEN
I $G(VAINST) S FDA(52.49,NERXIEN_",",24.1)=VAINST D FILE^DIE(,"FDA") K FDA
; if message type is 'Error', do not try to file the other components.
I MTYPE["Error" D Q NERXIEN
.S PATIEN=$$GETPAT^PSOERXU5(NERXIEN) Q:'PATIEN
.S FDA(52.49,NERXIEN_",",.04)=PATIEN D FILE^DIE(,"FDA") K FDA
D PAT(NERXIEN,MTYPE),BFC^PSOERXA5(NERXIEN),PHR^PSOERXA2(NERXIEN,MTYPE),PRE^PSOERXA2(NERXIEN,MTYPE)
D MED^PSOERXA3(NERXIEN,.ERXVALS,MTYPE),OBS(NERXIEN,MTYPE),SUP^PSOERXA2(NERXIEN,MTYPE)
D MEDDISP^PSOERXA5(NERXIEN,MTYPE)
I MTYPE="RefillResponse" D REFRESP^PSOERXA5(NERXIEN,MTYPE)
I MTYPE["Cancel" D
.S HUBDENY=$P(ERXHID,U,2)
.D CANRX^PSOERXA5(NERXIEN,MTYPE,HUBDENY,VAINST)
; facility/request have no where to go at this point in time??
D FAC^PSOERXA2(NERXIEN)
Q NERXIEN
;
OBS(ERXIEN,MTYPE) ; Observation
N GL,I,LAST,DIM,MSOURCE,MUNIT,OBSDT,MVAL,OBSNOTE,OBSCNT,F,EIENS,FDA,MDQUAL
S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Observation",0))
S F=52.4914,EIENS=ERXIEN_","
S I=-1,OBSCNT=0 F S I=$O(@GL@("Measurement",I)) Q:I="" D
.S OBSCNT=OBSCNT+1,FDA(F,"+1,"_EIENS,.01)=OBSCNT
.S DIM=$G(@GL@("Measurement",I,"Dimension",0)),FDA(F,"+1,"_EIENS,.02)=DIM
.S MDQUAL=$G(@GL@("Measurement",I,"MeasurementDataQualifier",0)),FDA(F,"+1,"_EIENS,.05)=MDQUAL
.S MSOURCE=$G(@GL@("Measurement",I,"MeasurementSourceCode",0)),FDA(F,"+1,"_EIENS,.06)=MSOURCE
.S MUNIT=$G(@GL@("Measurement",I,"MeasurementUnitCode",0)),FDA(F,"+1,"_EIENS,.07)=MUNIT
.S OBSDT=$G(@GL@("Measurement",I,"ObservationDate",0,"Date",0)),OBSDT=$$CONVDTTM^PSOERXA1(OBSDT),FDA(F,"+1,"_EIENS,.04)=OBSDT
.S MVAL=$G(@GL@("Measurement",I,"Value",0)),FDA(F,"+1,"_EIENS,.03)=MVAL
.D UPDATE^DIE(,"FDA") K FDA
S OBSNOTE=$G(@GL@("ObservationNotes",0)),FDA(52.49,EIENS,15)=OBSNOTE D FILE^DIE(,"FDA") K FDA
Q
PAT(ERXIEN,MTYPE) ; patient
N GL,AL1,AL2,CITY,STATE,ZIP,LN,FN,MN,PREF,SUFF,COMQUAL,COMVAL,PLQUAL,DOB,GEN,PRELATE,IDDONE,CDONE,I,C,CQUAL,CVAL
N IDNM,IDVAL,PFN,ERXPAT,NEWPAT,F,EIENS,FDA,IDFND,SRCH,PIENS,NPIEN,PATSSN,PREL,SIEN
S F=52.46
S EIENS=ERXIEN_","
S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0))
S PREL=$G(@GL@("PatientRelationship",0))
S FN=$$UP^XLFSTR($G(@GL@("Name",0,"FirstName",0)))
S LN=$$UP^XLFSTR($G(@GL@("Name",0,"LastName",0)))
S MN=$$UP^XLFSTR($G(@GL@("Name",0,"MiddleName",0)))
S PFN=LN_","_FN_$S(MN]"":" "_MN,1:"")
S SUFF=$$UP^XLFSTR($G(@GL@("Name",0,"Suffix",0)))
S PREF=$$UP^XLFSTR($G(@GL@("Name",0,"Prefix",0)))
S PRELATE=$G(@GL@("PatientRelationship",0))
S GEN=$G(@GL@("Gender",0))
S DOB=$G(@GL@("DateOfBirth",0,"Date",0)),DOB=$$CONVDTTM^PSOERXA1(DOB)
I DOB<1 S DOB=""
S AL1=$G(@GL@("Address",0,"AddressLine1",0))
S AL2=$G(@GL@("Address",0,"AddressLine2",0))
S CITY=$G(@GL@("Address",0,"City",0))
S STATE=$G(@GL@("Address",0,"State",0))
S ZIP=$G(@GL@("Address",0,"ZipCode",0))
S SIEN=$$STRES^PSOERXA2(ZIP,STATE)
; need to check for SSN before trying to match the patient. This needs to be stored in an array for later processing
; check 52.46 for a match before filing
S PATSSN=$G(@GL@("Identification",0,"SocialSecurity",0))
S ERXPAT=$$FINDPAT^PSOERXU2(PFN,DOB,GEN,$G(PATSSN),$G(AL1)) S PIENS=$S(ERXPAT:ERXPAT_",",1:"+1,")
; first, lets set up the main part
S FDA(F,PIENS,.01)=PFN,FDA(F,PIENS,.02)=LN,FDA(F,PIENS,.03)=FN,FDA(F,PIENS,.04)=MN,FDA(F,PIENS,.05)=SUFF,FDA(F,PIENS,.06)=PREF
S FDA(F,PIENS,.07)=GEN,FDA(F,PIENS,.08)=DOB
S FDA(F,PIENS,1.4)=PATSSN,FDA(F,PIENS,1.7)=PREL
S FDA(F,PIENS,3.1)=AL1,FDA(F,PIENS,3.2)=AL2,FDA(F,PIENS,3.3)=CITY
S FDA(F,PIENS,3.4)=SIEN
S FDA(F,PIENS,3.5)=ZIP
I PIENS["+" D Q
.D UPDATE^DIE(,"FDA","NEWPAT") K FDA
.S NPIEN=$O(NEWPAT(0)),NPIEN=$G(NEWPAT(NPIEN))
.Q:'NPIEN
.S NPIEN=NPIEN
.D PATC(NPIEN)
.S FDA(52.49,EIENS,.04)=NPIEN D FILE^DIE(,"FDA") K FDA
D FILE^DIE(,"FDA") K FDA D PATC(ERXPAT)
S FDA(52.49,EIENS,.04)=ERXPAT D FILE^DIE(,"FDA") K FDA
Q
PATC(IEN) ; patient communication
N IENS,CQUAL,CVAL,COMARY,FDA,SRCH,IDFND,IDNM,IDVAL,IDARY,PATSSN
Q:'IEN
S IENS=IEN_","
; Kill off existing communication values
K ^PS(52.46,IEN,3)
S C=-1 F S C=$O(@GL@("CommunicationNumbers",0,"Communication",C)) Q:C="" D
.S CQUAL=$G(@GL@("CommunicationNumbers",0,"Communication",C,"Qualifier",0))
.S CVAL=$G(@GL@("CommunicationNumbers",0,"Communication",C,"Number",0))
.S COMARY(CQUAL)=CVAL
.S FDA(52.462,"+1,"_IENS,.01)=CVAL
.S FDA(52.462,"+1,"_IENS,.02)=CQUAL
.D UPDATE^DIE(,"FDA") K FDA
; kill existing identification values in multiple
K ^PS(52.46,IEN,5)
S IDNM="" F S IDNM=$O(@GL@("Identification",0,IDNM)) Q:IDNM="" D
.S IDVAL=$G(@GL@("Identification",0,IDNM,0))
.I IDNM="SocialSecurity" S PATSSN=IDVAL
.S IDARY(IDNM)=IDVAL
.S IDFND=0
.S SRCH=0 F S SRCH=$O(^PS(52.46,IEN,5,SRCH)) Q:'SRCH D
..I $$GET1^DIQ(52.465,SRCH_","_IEN_",",.01)=IDNM D
...S IDFND=1
...S FDA(52.465,SRCH_","_IEN_",",.02)=IDVAL D FILE^DIE(,"FDA") K FDA
.Q:IDFND
.S FDA(52.465,"+1,"_IEN_",",.01)=IDNM
.S FDA(52.465,"+1,"_IEN_",",.02)=IDVAL
.D UPDATE^DIE(,"FDA") K FDA
I $G(PATSSN)]"" S FDA(52.46,IENS,1.4)=PATSSN D FILE^DIE(,"FDA") K FDA
Q
SPUSH(S,X) ;places X on the stack S and returns the current level of the stack
N I S I=$O(S(""),-1)+1,S(I)=X
Q I
;
SPOP(S,X) ;removes the top item from the stack S and put it into the variable X and returns the level that X was at
N I S I=$O(S(""),-1)
I I S X=S(I) K S(I)
N J S J=$O(S(I),-1) I J S S(J,X)=$G(S(J,X))+1
Q I
;
SPEEK(S,X) ;same as SPOP except the top item is not removed
N I S I=$O(S(""),-1)
I I S X=S(I)
Q I
;
SPUT(S,X) ;implementation specific, uses the stack to form a global node
N I,STR
S X=$TR(X,";","")
S STR=$P(GL,")")
S I=0 F S I=$O(S(I)) Q:'I D
.S STR=STR_","_""""_S(I)_""""_","
.N NUM S NUM=0
.I $D(S(I-1,S(I))) S NUM=+$G(S(I-1,S(I)))
.S STR=STR_NUM
S STR=STR_")"
I $D(@STR) S @STR=@STR_X
I '$D(@STR) S @STR=X
Q STR
APUT(S,X,LN) ; what am i doing here?
N I,STR
S X=$TR(X,";","")
S STR=$P(GL,")")
S I=0 F S I=$O(S(I)) Q:'I D
.S STR=STR_","_""""_S(I)_""""_","
.N NUM S NUM="""A"""
.S STR=STR_NUM_","_""""_LN_""""
S STR=STR_")"
I $D(@STR) S @STR=@STR_X
I '$D(@STR) S @STR=X
Q STR
;
; 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 ""
I VAL'["T" D Q VAL
.S X=$E(VAL,1,10),X=$TR(X,"-","")
.D ^%DT I 'Y S VAL="" Q
.I $P(VAL,"-",4) S ETIME=$TR($P(VAL,"-",4),":","")
.I $P(VAL,"+",2) S ETIME=$TR($P(VAL,"+",2),":","")
.I '$G(ETIME) S VAL=Y Q
.S VAL=Y_"."_ETIME
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
;
CSERX() ; Determine if an Incoming eRx is for a Controlled Substance Medication or not
; Output: "1" (Controlled Substance) or "0" (Non-Controlled Substance)
;
N DIGSIGVA
S DIGSIGVA=$G(@GL@("DigitalSignature",0,"SignatureValue",0))
I DIGSIGVA'="" Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXA1 13889 printed Apr 09, 2024@21:33:30 Page 2
PSOERXA1 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**467,520,508,551,581,617**;DEC 1997;Build 110
+2 ;
+3 QUIT
+4 ; File incoming XML into appropriate file
+5 ; XML - xml text
+6 ; PRCHK - provider check information
+7 ; PACHK - patient check information
+8 ; DACHK - drug auto check
+9 ; STATION - station #
+10 ; DIV - institution name^NPI
+11 ; ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)
+12 ; ERXVALS - code values for NIST codes
+13 ; XML2 - structured sig from the medication prescribed segment
+14 ; VADAT - DUZ^RXIEN
INCERX(RES,XML,PRCHK,PACHK,DACHK,STATION,DIV,ERXHID,ERXVALS,XML2,VADAT) ;
+1 NEW CURREC,FDA,EIEN,ERRTXT,ERRSEQ,PACNT,PASCNT,PAICN,PAIEN,VAINST,NPI,VAOI,VPATINST,NEWVAL
+2 SET NPI=$PIECE($GET(DIV),U,2)
+3 SET CURREC=$$PARSE(.XML,.ERXVALS,NPI,.XML2)
+4 IF $PIECE(CURREC,U)<1
Begin DoDot:1
+5 IF $LENGTH($PIECE(CURREC,U,2))
SET RES=CURREC
QUIT
+6 SET RES="0^XML received. Error creating or finding associated record in the ERX Holding queue."
QUIT
End DoDot:1
QUIT
+7 SET EIEN=CURREC
+8 SET CURREC=CURREC_","
+9 ; if this is an outbound message, file the users DUZ and quit back the response. no drug, patient, or provider auto checks will occur
+10 IF $DATA(VADAT)
Begin DoDot:1
+11 IF $PIECE($GET(VADAT),U)>1
Begin DoDot:2
+12 SET FDA(52.49,CURREC,51.1)=DUZ
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:2
+13 IF $PIECE(VADAT,U,2)
Begin DoDot:2
+14 SET FDA(52.49,CURREC,.13)=$PIECE(VADAT,U,2)
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:2
+15 SET RES="1^Erx Received."
End DoDot:1
QUIT
+16 ; Process auto-validation results. only log positive results for now
+17 KILL FDA
+18 IF $PIECE($GET(VADAT),U)
SET RES="1^Message Filed."
QUIT
+19 IF $GET(DACHK("success"))="true"
Begin DoDot:1
+20 IF $GET(DACHK("IEN"))
Begin DoDot:2
+21 ;Saving the eRx Audit Log For Auto-Matched Drug
+22 SET NEWVAL(1)=$$GET1^DIQ(50,DACHK("IEN"),.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(DACHK("IEN"))_")"
+23 DO AUDLOG^PSOERXUT(+CURREC,"DRUG",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
+24 ;Setting Matched Drug and Auto Match info
+25 SET FDA(52.49,CURREC,1.4)=1
+26 SET FDA(52.49,CURREC,3.2)=DACHK("IEN")
+27 SET FDA(52.49,CURREC,44)=1
+28 SET VAOI=$$GET1^DIQ(50,DACHK("IEN"),2.1,"I")
+29 SET VPATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
+30 IF $LENGTH(VPATINST)
SET FDA(52.49,CURREC,27)=VPATINST
End DoDot:2
End DoDot:1
+31 IF $GET(DACHK("success"))="false"
Begin DoDot:1
+32 SET ERRTXT=$GET(DACHK("error"))
+33 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+34 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"D","E",ERRTXT)
End DoDot:1
+35 IF $GET(PRCHK("success"))="true"
Begin DoDot:1
+36 IF PRCHK("IEN")
Begin DoDot:2
+37 SET FDA(52.49,CURREC,1.2)=1
+38 SET FDA(52.49,CURREC,2.3)=PRCHK("IEN")
+39 ;Saving the eRx Audit Log for the Auto-Matched Provider
+40 SET NEWVAL(1)=$$GET1^DIQ(200,PRCHK("IEN"),.01)_" (DEA#: "_$$DEA^XUSER(0,PRCHK("IEN"))_")"
+41 DO AUDLOG^PSOERXUT(+CURREC,"PROVIDER",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
End DoDot:2
End DoDot:1
+42 IF $GET(PRCHK("success"))="false"
Begin DoDot:1
+43 SET ERRTXT=$GET(PRCHK("error"))
+44 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+45 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PR","E",ERRTXT)
End DoDot:1
+46 IF $GET(PACHK("MVIerror"))']""
Begin DoDot:1
+47 SET PAICN=+$PIECE($GET(PACHK("ICN")),"V")
+48 IF PAICN
Begin DoDot:2
+49 SET (PAIEN,PACNT)=0
FOR
SET PAIEN=$ORDER(^DPT("AICN",PAICN,PAIEN))
if 'PAIEN
QUIT
Begin DoDot:3
+50 SET PACNT=PACNT+1
+51 ; 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
+52 IF $GET(PACNT)=1
Begin DoDot:2
+53 SET FDA(52.49,CURREC,1.6)=1
+54 SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("AICN",PAICN,0))
End DoDot:2
QUIT
+55 IF $LENGTH(PACHK("ssn"))
Begin DoDot:2
+56 SET (PASCNT,PAIEN)=0
FOR
SET PAIEN=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),PAIEN))
if 'PAIEN
QUIT
Begin DoDot:3
+57 SET PASCNT=PASCNT+1
End DoDot:3
End DoDot:2
+58 IF $GET(PASCNT)=1
Begin DoDot:2
+59 SET FDA(52.49,CURREC,1.6)=1
+60 SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),0))
End DoDot:2
QUIT
End DoDot:1
+61 IF $DATA(FDA)
DO FILE^DIE(,"FDA")
KILL FDA
+62 ;
+63 ;Saving the eRx Audit Log For Auto-Matched Patient
+64 IF $GET(FDA(52.49,CURREC,.05))
Begin DoDot:1
+65 NEW DFN,VADM
SET DFN=+FDA(52.49,CURREC,.05)
DO DEM^VADPT
+66 SET NEWVAL(1)=$$GET1^DIQ(2,DFN,.01)_" (L4SSN: "_$PIECE($PIECE(VADM(2),"^",2),"-",3)_" | DOB: "_$PIECE(VADM(3),"^",2)_")"
+67 DO AUDLOG^PSOERXUT(+CURREC,"PATIENT",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
End DoDot:1
+68 ;
+69 IF $DATA(FDA)
DO FILE^DIE(,"FDA")
KILL FDA
+70 IF $GET(PACHK("success"))="false"
Begin DoDot:1
+71 ; file e&e error
+72 SET ERRTXT=$GET(PACHK("EandEerror"))
IF ERRTXT]""
Begin DoDot:2
+73 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+74 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
End DoDot:2
+75 ; file mvi error
+76 SET ERRTXT=$GET(PACHK("MVIerror"))
IF ERRTXT]""
Begin DoDot:2
+77 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+78 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
End DoDot:2
End DoDot:1
+79 SET RES="1^Erx Received."
+80 QUIT
PARSE(STREAM,ERXVALS,NPI,STREAM2) ;
+1 NEW %XML,GL,VAINST,MTYPE,HUBDENY
+2 SET GL=$NAME(^TMP($JOB,"PSOERXO1"))
+3 KILL @GL
+4 NEW STATUS,READER,XOBERR,S,ATTR,READER2,XOBERR2,STATUS2
+5 SET STREAM=$TRANSLATE(STREAM,"^","")
+6 IF $LENGTH(STREAM2)
SET STREAM2=$TRANSLATE(STREAM2,"^","")
+7 SET STATUS=##class(%XML.TextReader).ParseStream(STREAM,.READER,,,,,1)
+8 IF $LENGTH(STREAM2)
SET STATUS2=##class(%XML.TextReader).ParseStream(STREAM2,.READER2,,,,,1)
+9 IF $$STATCHK^XOBWLIB(STATUS,.XOBERR,1)
Begin DoDot:1
+10 NEW BREAK
+11 SET BREAK=0
FOR
if BREAK||READER.EOF||'READER.Read()
QUIT
Begin DoDot:2
+12 NEW X,PUSHED,PARENT
+13 IF READER.AttributeCount
Begin DoDot:3
+14 SET PARENT=READER.LocalName
+15 DO SPUSH(.S,PARENT)
SET PUSHED=1
+16 FOR ATTR=1:1:READER.AttributeCount
Begin DoDot:4
+17 DO READER.MoveToAttributeIndex(ATTR)
+18 IF READER.NodeType="attribute"
DO APUT(.S,READER.Value,READER.LocalName)
End DoDot:4
End DoDot:3
+19 IF READER.NodeType="element"
IF '$GET(PUSHED)
DO SPUSH(.S,READER.LocalName)
+20 ; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
+21 IF READER.NodeType="element"
IF READER.IsEmptyElement
DO SPUT(.S,"")
+22 IF READER.NodeType="endelement"
DO SPOP(.S,.X)
+23 IF READER.NodeType="chars"
DO SPUT(.S,READER.Value)
End DoDot:2
End DoDot:1
+24 IF $DATA(STATUS2)
Begin DoDot:1
+25 IF $$STATCHK^XOBWLIB(STATUS2,.XOBERR2,1)
Begin DoDot:2
+26 NEW BREAK,S
+27 SET BREAK=0
FOR
if BREAK||READER2.EOF||'READER2.Read()
QUIT
Begin DoDot:3
+28 NEW X,PUSHED,PARENT
+29 IF READER2.AttributeCount
Begin DoDot:4
+30 SET PARENT=READER2.LocalName
+31 DO SPUSH(.S,PARENT)
SET PUSHED=1
+32 FOR ATTR=1:1:READER2.AttributeCount
Begin DoDot:5
+33 DO READER2.MoveToAttributeIndex(ATTR)
+34 IF READER2.NodeType="attribute"
DO APUT(.S,READER2.Value,READER2.LocalName)
End DoDot:5
End DoDot:4
+35 IF READER2.NodeType="element"
IF '$GET(PUSHED)
DO SPUSH(.S,READER2.LocalName)
+36 ; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
+37 IF READER.NodeType="element"
IF READER.IsEmptyElement
DO SPUT(.S,"")
+38 IF READER2.NodeType="endelement"
DO SPOP(.S,.X)
+39 IF READER2.NodeType="chars"
DO SPUT(.S,READER2.Value)
End DoDot:3
End DoDot:2
End DoDot:1
+40 SET MTYPE=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,""))
if MTYPE']""
QUIT "0^Message type could not be identified."
+41 IF '$LENGTH(NPI)
SET NPI=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Identification",0,"NPI",0))
+42 IF '$LENGTH(NPI)
QUIT "0^Missing NPI. Institution could not be resolved. eRx not filed."
+43 SET VAINST=$$FIND1^DIC(4,,"O",NPI,"ANPI")
+44 IF '$GET(VAINST)
QUIT "0^Institution could not be resolved. eRx not filed."
+45 NEW NERXIEN,ERR,PATIEN
+46 SET NERXIEN=$$HDR^PSOERXA3(MTYPE)
+47 IF $PIECE(NERXIEN,U)<1
QUIT NERXIEN
+48 IF $GET(VAINST)
SET FDA(52.49,NERXIEN_",",24.1)=VAINST
DO FILE^DIE(,"FDA")
KILL FDA
+49 ; if message type is 'Error', do not try to file the other components.
+50 IF MTYPE["Error"
Begin DoDot:1
+51 SET PATIEN=$$GETPAT^PSOERXU5(NERXIEN)
if 'PATIEN
QUIT
+52 SET FDA(52.49,NERXIEN_",",.04)=PATIEN
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
QUIT NERXIEN
+53 DO PAT(NERXIEN,MTYPE)
DO BFC^PSOERXA5(NERXIEN)
DO PHR^PSOERXA2(NERXIEN,MTYPE)
DO PRE^PSOERXA2(NERXIEN,MTYPE)
+54 DO MED^PSOERXA3(NERXIEN,.ERXVALS,MTYPE)
DO OBS(NERXIEN,MTYPE)
DO SUP^PSOERXA2(NERXIEN,MTYPE)
+55 DO MEDDISP^PSOERXA5(NERXIEN,MTYPE)
+56 IF MTYPE="RefillResponse"
DO REFRESP^PSOERXA5(NERXIEN,MTYPE)
+57 IF MTYPE["Cancel"
Begin DoDot:1
+58 SET HUBDENY=$PIECE(ERXHID,U,2)
+59 DO CANRX^PSOERXA5(NERXIEN,MTYPE,HUBDENY,VAINST)
End DoDot:1
+60 ; facility/request have no where to go at this point in time??
+61 DO FAC^PSOERXA2(NERXIEN)
+62 QUIT NERXIEN
+63 ;
OBS(ERXIEN,MTYPE) ; Observation
+1 NEW GL,I,LAST,DIM,MSOURCE,MUNIT,OBSDT,MVAL,OBSNOTE,OBSCNT,F,EIENS,FDA,MDQUAL
+2 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Observation",0))
+3 SET F=52.4914
SET EIENS=ERXIEN_","
+4 SET I=-1
SET OBSCNT=0
FOR
SET I=$ORDER(@GL@("Measurement",I))
if I=""
QUIT
Begin DoDot:1
+5 SET OBSCNT=OBSCNT+1
SET FDA(F,"+1,"_EIENS,.01)=OBSCNT
+6 SET DIM=$GET(@GL@("Measurement",I,"Dimension",0))
SET FDA(F,"+1,"_EIENS,.02)=DIM
+7 SET MDQUAL=$GET(@GL@("Measurement",I,"MeasurementDataQualifier",0))
SET FDA(F,"+1,"_EIENS,.05)=MDQUAL
+8 SET MSOURCE=$GET(@GL@("Measurement",I,"MeasurementSourceCode",0))
SET FDA(F,"+1,"_EIENS,.06)=MSOURCE
+9 SET MUNIT=$GET(@GL@("Measurement",I,"MeasurementUnitCode",0))
SET FDA(F,"+1,"_EIENS,.07)=MUNIT
+10 SET OBSDT=$GET(@GL@("Measurement",I,"ObservationDate",0,"Date",0))
SET OBSDT=$$CONVDTTM^PSOERXA1(OBSDT)
SET FDA(F,"+1,"_EIENS,.04)=OBSDT
+11 SET MVAL=$GET(@GL@("Measurement",I,"Value",0))
SET FDA(F,"+1,"_EIENS,.03)=MVAL
+12 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:1
+13 SET OBSNOTE=$GET(@GL@("ObservationNotes",0))
SET FDA(52.49,EIENS,15)=OBSNOTE
DO FILE^DIE(,"FDA")
KILL FDA
+14 QUIT
PAT(ERXIEN,MTYPE) ; patient
+1 NEW GL,AL1,AL2,CITY,STATE,ZIP,LN,FN,MN,PREF,SUFF,COMQUAL,COMVAL,PLQUAL,DOB,GEN,PRELATE,IDDONE,CDONE,I,C,CQUAL,CVAL
+2 NEW IDNM,IDVAL,PFN,ERXPAT,NEWPAT,F,EIENS,FDA,IDFND,SRCH,PIENS,NPIEN,PATSSN,PREL,SIEN
+3 SET F=52.46
+4 SET EIENS=ERXIEN_","
+5 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0))
+6 SET PREL=$GET(@GL@("PatientRelationship",0))
+7 SET FN=$$UP^XLFSTR($GET(@GL@("Name",0,"FirstName",0)))
+8 SET LN=$$UP^XLFSTR($GET(@GL@("Name",0,"LastName",0)))
+9 SET MN=$$UP^XLFSTR($GET(@GL@("Name",0,"MiddleName",0)))
+10 SET PFN=LN_","_FN_$SELECT(MN]"":" "_MN,1:"")
+11 SET SUFF=$$UP^XLFSTR($GET(@GL@("Name",0,"Suffix",0)))
+12 SET PREF=$$UP^XLFSTR($GET(@GL@("Name",0,"Prefix",0)))
+13 SET PRELATE=$GET(@GL@("PatientRelationship",0))
+14 SET GEN=$GET(@GL@("Gender",0))
+15 SET DOB=$GET(@GL@("DateOfBirth",0,"Date",0))
SET DOB=$$CONVDTTM^PSOERXA1(DOB)
+16 IF DOB<1
SET DOB=""
+17 SET AL1=$GET(@GL@("Address",0,"AddressLine1",0))
+18 SET AL2=$GET(@GL@("Address",0,"AddressLine2",0))
+19 SET CITY=$GET(@GL@("Address",0,"City",0))
+20 SET STATE=$GET(@GL@("Address",0,"State",0))
+21 SET ZIP=$GET(@GL@("Address",0,"ZipCode",0))
+22 SET SIEN=$$STRES^PSOERXA2(ZIP,STATE)
+23 ; need to check for SSN before trying to match the patient. This needs to be stored in an array for later processing
+24 ; check 52.46 for a match before filing
+25 SET PATSSN=$GET(@GL@("Identification",0,"SocialSecurity",0))
+26 SET ERXPAT=$$FINDPAT^PSOERXU2(PFN,DOB,GEN,$GET(PATSSN),$GET(AL1))
SET PIENS=$SELECT(ERXPAT:ERXPAT_",",1:"+1,")
+27 ; first, lets set up the main part
+28 SET FDA(F,PIENS,.01)=PFN
SET FDA(F,PIENS,.02)=LN
SET FDA(F,PIENS,.03)=FN
SET FDA(F,PIENS,.04)=MN
SET FDA(F,PIENS,.05)=SUFF
SET FDA(F,PIENS,.06)=PREF
+29 SET FDA(F,PIENS,.07)=GEN
SET FDA(F,PIENS,.08)=DOB
+30 SET FDA(F,PIENS,1.4)=PATSSN
SET FDA(F,PIENS,1.7)=PREL
+31 SET FDA(F,PIENS,3.1)=AL1
SET FDA(F,PIENS,3.2)=AL2
SET FDA(F,PIENS,3.3)=CITY
+32 SET FDA(F,PIENS,3.4)=SIEN
+33 SET FDA(F,PIENS,3.5)=ZIP
+34 IF PIENS["+"
Begin DoDot:1
+35 DO UPDATE^DIE(,"FDA","NEWPAT")
KILL FDA
+36 SET NPIEN=$ORDER(NEWPAT(0))
SET NPIEN=$GET(NEWPAT(NPIEN))
+37 if 'NPIEN
QUIT
+38 SET NPIEN=NPIEN
+39 DO PATC(NPIEN)
+40 SET FDA(52.49,EIENS,.04)=NPIEN
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
QUIT
+41 DO FILE^DIE(,"FDA")
KILL FDA
DO PATC(ERXPAT)
+42 SET FDA(52.49,EIENS,.04)=ERXPAT
DO FILE^DIE(,"FDA")
KILL FDA
+43 QUIT
PATC(IEN) ; patient communication
+1 NEW IENS,CQUAL,CVAL,COMARY,FDA,SRCH,IDFND,IDNM,IDVAL,IDARY,PATSSN
+2 if 'IEN
QUIT
+3 SET IENS=IEN_","
+4 ; Kill off existing communication values
+5 KILL ^PS(52.46,IEN,3)
+6 SET C=-1
FOR
SET C=$ORDER(@GL@("CommunicationNumbers",0,"Communication",C))
if C=""
QUIT
Begin DoDot:1
+7 SET CQUAL=$GET(@GL@("CommunicationNumbers",0,"Communication",C,"Qualifier",0))
+8 SET CVAL=$GET(@GL@("CommunicationNumbers",0,"Communication",C,"Number",0))
+9 SET COMARY(CQUAL)=CVAL
+10 SET FDA(52.462,"+1,"_IENS,.01)=CVAL
+11 SET FDA(52.462,"+1,"_IENS,.02)=CQUAL
+12 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:1
+13 ; kill existing identification values in multiple
+14 KILL ^PS(52.46,IEN,5)
+15 SET IDNM=""
FOR
SET IDNM=$ORDER(@GL@("Identification",0,IDNM))
if IDNM=""
QUIT
Begin DoDot:1
+16 SET IDVAL=$GET(@GL@("Identification",0,IDNM,0))
+17 IF IDNM="SocialSecurity"
SET PATSSN=IDVAL
+18 SET IDARY(IDNM)=IDVAL
+19 SET IDFND=0
+20 SET SRCH=0
FOR
SET SRCH=$ORDER(^PS(52.46,IEN,5,SRCH))
if 'SRCH
QUIT
Begin DoDot:2
+21 IF $$GET1^DIQ(52.465,SRCH_","_IEN_",",.01)=IDNM
Begin DoDot:3
+22 SET IDFND=1
+23 SET FDA(52.465,SRCH_","_IEN_",",.02)=IDVAL
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:3
End DoDot:2
+24 if IDFND
QUIT
+25 SET FDA(52.465,"+1,"_IEN_",",.01)=IDNM
+26 SET FDA(52.465,"+1,"_IEN_",",.02)=IDVAL
+27 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:1
+28 IF $GET(PATSSN)]""
SET FDA(52.46,IENS,1.4)=PATSSN
DO FILE^DIE(,"FDA")
KILL FDA
+29 QUIT
SPUSH(S,X) ;places X on the stack S and returns the current level of the stack
+1 NEW I
SET I=$ORDER(S(""),-1)+1
SET S(I)=X
+2 QUIT I
+3 ;
SPOP(S,X) ;removes the top item from the stack S and put it into the variable X and returns the level that X was at
+1 NEW I
SET I=$ORDER(S(""),-1)
+2 IF I
SET X=S(I)
KILL S(I)
+3 NEW J
SET J=$ORDER(S(I),-1)
IF J
SET S(J,X)=$GET(S(J,X))+1
+4 QUIT I
+5 ;
SPEEK(S,X) ;same as SPOP except the top item is not removed
+1 NEW I
SET I=$ORDER(S(""),-1)
+2 IF I
SET X=S(I)
+3 QUIT I
+4 ;
SPUT(S,X) ;implementation specific, uses the stack to form a global node
+1 NEW I,STR
+2 SET X=$TRANSLATE(X,";","")
+3 SET STR=$PIECE(GL,")")
+4 SET I=0
FOR
SET I=$ORDER(S(I))
if 'I
QUIT
Begin DoDot:1
+5 SET STR=STR_","_""""_S(I)_""""_","
+6 NEW NUM
SET NUM=0
+7 IF $DATA(S(I-1,S(I)))
SET NUM=+$GET(S(I-1,S(I)))
+8 SET STR=STR_NUM
End DoDot:1
+9 SET STR=STR_")"
+10 IF $DATA(@STR)
SET @STR=@STR_X
+11 IF '$DATA(@STR)
SET @STR=X
+12 QUIT STR
APUT(S,X,LN) ; what am i doing here?
+1 NEW I,STR
+2 SET X=$TRANSLATE(X,";","")
+3 SET STR=$PIECE(GL,")")
+4 SET I=0
FOR
SET I=$ORDER(S(I))
if 'I
QUIT
Begin DoDot:1
+5 SET STR=STR_","_""""_S(I)_""""_","
+6 NEW NUM
SET NUM="""A"""
+7 SET STR=STR_NUM_","_""""_LN_""""
End DoDot:1
+8 SET STR=STR_")"
+9 IF $DATA(@STR)
SET @STR=@STR_X
+10 IF '$DATA(@STR)
SET @STR=X
+11 QUIT STR
+12 ;
+13 ; VAL - value to resolve
+14 ; 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 IF VAL'["T"
Begin DoDot:1
+4 SET X=$EXTRACT(VAL,1,10)
SET X=$TRANSLATE(X,"-","")
+5 DO ^%DT
IF 'Y
SET VAL=""
QUIT
+6 IF $PIECE(VAL,"-",4)
SET ETIME=$TRANSLATE($PIECE(VAL,"-",4),":","")
+7 IF $PIECE(VAL,"+",2)
SET ETIME=$TRANSLATE($PIECE(VAL,"+",2),":","")
+8 IF '$GET(ETIME)
SET VAL=Y
QUIT
+9 SET VAL=Y_"."_ETIME
End DoDot:1
QUIT VAL
+10 SET EDATE=$PIECE(VAL,"T")
SET ETIME=$PIECE(VAL,"T",2)
+11 ; split off time zone
+12 SET ETZ=$PIECE(ETIME,".",2)
+13 SET ETIME=$PIECE(ETIME,".")
+14 SET X=EDATE
DO ^%DT
IF 'Y
QUIT ""
+15 SET VAL=Y_$SELECT($LENGTH(ETIME):"."_$TRANSLATE(ETIME,":",""),1:"")
+16 QUIT VAL
+17 ;
CSERX() ; Determine if an Incoming eRx is for a Controlled Substance Medication or not
+1 ; Output: "1" (Controlled Substance) or "0" (Non-Controlled Substance)
+2 ;
+3 NEW DIGSIGVA
+4 SET DIGSIGVA=$GET(@GL@("DigitalSignature",0,"SignatureValue",0))
+5 IF DIGSIGVA'=""
QUIT 1
+6 QUIT 0
