PSOERXU9 ;ALB/ART - eRx Holding Queue Utilities ;02/02/2021
;;7.0;OUTPATIENT PHARMACY;**617,700,746**;DEC 1997;Build 106
;
ERXIEN(RXIEN) ;Pass through to $$ERXIEN^PSOERXUT
; Input: (r) RXIEN - Pointer to either the PENDING ORDERS file (#52.41) (e.g., "139839P") or PRESCRIPTION file (#52) (e.g., 12930984)
;Returns: Pointer to the ERX HOLDING QUEUE file (#52.49) or "" (Not an eRx prescription)
;
I $G(RXIEN)="" Q:""
Q $$ERXIEN^PSOERXUT(RXIEN)
;
CHKERX(ORDERIEN) ;Pass through to $$CHKERX^PSOERXU1
; Input: (r) ORDERIEN - Order (100) file IEN
;Returns: Pointer to the ERX HOLDING QUEUE file (#52.49) or 0 (Not an eRx prescription)
;
I $G(ORDERIEN)="" Q:0
Q $$CHKERX^PSOERXU1(ORDERIEN)
;
ERXPATDFN(ERXIEN) ;Get patient DFN from eRx Holding Queue (52.49)
; Input: (r) ERXIEN - eRx Holding Queue IEN
;Returns: patient DFN from eRx Holding Queue
; or 0, if not found
;
I $G(ERXIEN)="" Q:0
Q +$$GET1^DIQ(52.49,ERXIEN,.04,"I")
;
ERXPATDOB(ERXDFN) ;Get patient DoB from ERX External Patient (52.46)
; Input: (r) ERXDFN - patient DFN from eRx Holding Queue (52.49)
;Returns: patient DoB from ERX External Patient (52.46)
; or null
;
I $G(ERXDFN)="" Q:""
Q $$FMTE^XLFDT($$GET1^DIQ(52.46,ERXDFN,.08,"I"),"5DZ")
;
ERXHUBID(ERXIEN) ;Get ERX HUB ID (.01) from eRx Holding Queue (52.49)
; Input: (r) ERXIEN - eRx Holding Queue IEN
;Returns: ERX HUB ID
; or null
;
I $G(ERXIEN)="" Q:""
Q $S(ERXIEN:$$GET1^DIQ(52.49,ERXIEN,.01),1:"")
;
ERXDATA(ERXDATA,ERXIEN) ;Get eRx Holding Queue Data
;Inputs: (r) ERXDATA - reference to return array
; (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
;Output: Populated ERXDATA array
; ERXDATA(1)=null ^ eRxReceivedDate(FileMan) ^ eRxDrugName ^ VistaDrugIEN ^ CSdrugSchedule ^ eRxQuantity ^ eRxRefill ^ eRxHubID
; ERXDATA(2)=providerDEA# ^ null ^ providerName ^ providerDUZ
; ERXDATA(3)=null ^ provStreet1 ^ provCity ^ provState ^ provZip
; ERXDATA(4)=patientName ^ patientDFN
; ERXDATA(5)=patStreet1 ^ patStreet2 ^ null ^ patCity ^ patState ^ patZip ^ patDOB(MM/DD/YYYY)
;
Q:'$G(ERXIEN)
Q:'$D(^PS(52.49,ERXIEN,0))
K ERXDATA
;get eRx Holding Queue fields
N ERXHQ,ERR
N ERXIENS S ERXIENS=ERXIEN_","
D GETS^DIQ(52.49,ERXIENS,".01;.03;.04;.05;2.1;2.3;2.5;3.1;3.2;4.9;5.1;5.6","EI","ERXHQ","ERR")
N HUBID S HUBID=$G(ERXHQ(52.49,ERXIENS,.01,"I")) ;eRx Hub ID
N RCVDDATE S RCVDDATE=$G(ERXHQ(52.49,ERXIENS,.03,"I")) ;eRx Received Date
N EXPATIEN S EXPATIEN=$G(ERXHQ(52.49,ERXIENS,.04,"I")) ;eRx External Patient ID
N EXPATDFN S EXPATDFN=$G(ERXHQ(52.49,ERXIENS,.05,"I")) ;eRx External Patient VistA DFN
N EXPRVIEN S EXPRVIEN=$G(ERXHQ(52.49,ERXIENS,2.1,"I")) ;eRx External Provider ID
N EXPRVDUZ S EXPRVDUZ=$G(ERXHQ(52.49,ERXIENS,2.3,"I")) ;eRx External Provider VistA ID
N EXPHID S EXPHID=$G(ERXHQ(52.49,ERXIENS,2.5,"I")) ;eRx External Pharmacy ID
N DRUGNAME S DRUGNAME=$G(ERXHQ(52.49,ERXIENS,3.1,"I")) ;eRx Generic name
N DRUGIEN S DRUGIEN=$G(ERXHQ(52.49,ERXIENS,3.2,"I")) ;eRx Drug IEN
N EXDEA S EXDEA=$G(ERXHQ(52.49,ERXIENS,4.9,"E")) ;eRx DEA Schedule
S EXDEA=$S(EXDEA="C48672":1,EXDEA="C48675":2,EXDEA="C48676":3,EXDEA="C48677":4,EXDEA="C48679":5,1:"")
N ERXQUANT S ERXQUANT=$G(ERXHQ(52.49,ERXIENS,5.1,"E")) ;eRx Quantity
N ERXREFIL S ERXREFIL=$G(ERXHQ(52.49,ERXIENS,5.6,"E")) ;eRx Refills
;get eRx External Pharmacy fields
N ERXPHARM,ERR
N EXPHIDS S EXPHIDS=EXPHID_","
D GETS^DIQ(52.47,EXPHIDS,".01;.04;1.1;1.3;1.4;1.5","EI","ERXPHARM","ERR")
N PHNAME S PHNAME=$G(ERXPHARM(52.47,EXPHIDS,.01,"E")) ;eRx pharmacy name
N PHDEA S PHDEA=$G(ERXPHARM(52.47,EXPHIDS,.04,"E")) ;eRx pharmacy dea number
N PHSTREET S PHSTREET=$G(ERXPHARM(52.47,EXPHIDS,1.1,"E")) ;eRx pharmacy address line 1
N PHCITY S PHCITY=$G(ERXPHARM(52.47,EXPHIDS,1.3,"E")) ;eRx pharmacy city
N PHSTATE S PHSTATE=$G(ERXPHARM(52.47,EXPHIDS,1.4,"E")) ;eRx pharmacy state
N PHZIP S PHZIP=$G(ERXPHARM(52.47,EXPHIDS,1.5,"E")) ;eRx pharmacy zip
;get eRx External Provider fields
N ERXPROV,ERR
N EXPRVIENS S EXPRVIENS=EXPRVIEN_","
D GETS^DIQ(52.48,EXPRVIENS,".01;1.6;4.1;4.2;4.3;4.4;4.5","EI","ERXPROV","ERR")
N PROVNAME S PROVNAME=$G(ERXPROV(52.48,EXPRVIENS,.01,"E")) ;eRx provider name
N PRVDEANBR S PRVDEANBR=$G(ERXPROV(52.48,EXPRVIENS,1.6,"E")) ;eRx provider dea#
N PRVSTR1 S PRVSTR1=$G(ERXPROV(52.48,EXPRVIENS,4.1,"E")) ;eRx provider street 1
N PRVSTR2 S PRVSTR2=$G(ERXPROV(52.48,EXPRVIENS,4.2,"E")) ;eRx provider street 2
N PRVCITY S PRVCITY=$G(ERXPROV(52.48,EXPRVIENS,4.3,"E")) ;eRx provider city
N PRVSTATE S PRVSTATE=$G(ERXPROV(52.48,EXPRVIENS,4.4,"E")) ;eRx provider state
N PRVZIP S PRVZIP=$G(ERXPROV(52.48,EXPRVIENS,4.5,"E")) ;eRx provider zip
;get eRx External Patient fields
N ERXPAT,ERR
N EXPATIENS S EXPATIENS=EXPATIEN_","
D GETS^DIQ(52.46,EXPATIENS,".01;.08;1.5;3.1;3.2;3.3;3.4;3.5","EI","ERXPAT","ERR")
N PATNAME S PATNAME=$G(ERXPAT(52.46,EXPATIENS,.01,"E")) ;eRx patient name
N PATDOB S PATDOB=$G(ERXPAT(52.46,EXPATIENS,.08,"I")) ;eRx patient DoB
N PATDFN S PATDFN=$G(ERXPAT(52.46,EXPATIENS,1.5,"E")) ;eRx patient dfn
N PATSTR1 S PATSTR1=$G(ERXPAT(52.46,EXPATIENS,3.1,"E")) ;eRx street 1
N PATSTR2 S PATSTR2=$G(ERXPAT(52.46,EXPATIENS,3.2,"E")) ;eRx street 2
N PATCITY S PATCITY=$G(ERXPAT(52.46,EXPATIENS,3.3,"E")) ;eRx city
N PATSTATE S PATSTATE=$G(ERXPAT(52.46,EXPATIENS,3.4,"E")) ;eRx state
N PATZIP S PATZIP=$G(ERXPAT(52.46,EXPATIENS,3.5,"E")) ;eRx zip
;
S ERXDATA(1)=U_RCVDDATE_U_DRUGNAME_U_DRUGIEN_U_EXDEA_U_ERXQUANT_U_ERXREFIL_U_HUBID
S ERXDATA(2)=PRVDEANBR_U_U_PROVNAME_U_EXPRVDUZ
S ERXDATA(3)=U_PRVSTR1_U_PRVCITY_U_PRVSTATE_U_PRVZIP
S ERXDATA(4)=PATNAME_U_EXPATDFN
S ERXDATA(5)=PATSTR1_U_PATSTR2_U_""_U_PATCITY_U_PATSTATE_U_PATZIP_U_$$FMTE^XLFDT(PATDOB,"5DZ")
;
Q
;
ALRGDATA(ALRGDATA,ERXIEN,SORTED) ; Get eRx Patient Allergy Data
;Inputs: (r) ALRGDATA - reference to return array
; (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
; (o) SORTED - Return the list of Allergies in Alphabetical Order
;
;Output: Populated ALRGDATA array. This is a sub-multiple data so each row of the array is one sequence number
; ALRGDATA(n)=Seguence number^Source of information^Effective date^Expiration date^Drug product code^Drug product qualifier
; ^Drug product text^Reaction text^reaction code^Severity text^Severity code^Adverse event text^Adverse event code
;
Q:'$D(^PS(52.49,+$G(ERXIEN),0))
K ALRGDATA
;
N DATA,ALRARRAY
D GETS^DIQ(52.49,ERXIEN,"303*","IE","DATA") M ALRARRAY=DATA(52.49303)
;
N EXSEQ,INDEX,TMPDATA,COUNT
S EXSEQ=""
F S EXSEQ=$O(ALRARRAY(EXSEQ)) Q:EXSEQ="" D
. S INDEX=$S($G(SORTED):ALRARRAY(EXSEQ,3,"E")_" "_EXSEQ,1:EXSEQ)
. S $P(TMPDATA(INDEX),U,1)=ALRARRAY(EXSEQ,.01,"E")
. S $P(TMPDATA(INDEX),U,2)=ALRARRAY(EXSEQ,.02,"E")
. S $P(TMPDATA(INDEX),U,3)=ALRARRAY(EXSEQ,.03,"I")
. S $P(TMPDATA(INDEX),U,4)=ALRARRAY(EXSEQ,.04,"E")
. S $P(TMPDATA(INDEX),U,5)=ALRARRAY(EXSEQ,1,"E")
. S $P(TMPDATA(INDEX),U,6)=ALRARRAY(EXSEQ,2,"E")
. S $P(TMPDATA(INDEX),U,7)=ALRARRAY(EXSEQ,3,"E")
. S $P(TMPDATA(INDEX),U,8)=ALRARRAY(EXSEQ,4,"E")
. S $P(TMPDATA(INDEX),U,9)=ALRARRAY(EXSEQ,5,"E")
. S $P(TMPDATA(INDEX),U,10)=ALRARRAY(EXSEQ,6,"E")
. S $P(TMPDATA(INDEX),U,11)=ALRARRAY(EXSEQ,7,"E")
. S $P(TMPDATA(INDEX),U,12)=ALRARRAY(EXSEQ,8,"E")
. S $P(TMPDATA(INDEX),U,13)=ALRARRAY(EXSEQ,9,"E")
S EXSEQ="",COUNT=0
F S EXSEQ=$O(TMPDATA(EXSEQ)) Q:EXSEQ="" D
. S COUNT=COUNT+1,ALRGDATA(COUNT)=TMPDATA(EXSEQ)
Q
;
PDUEDATA(PDUEDATA,ERXIEN,SORTED) ; Get eRx Prescriber Drug Use Evaluation Data
;Inputs: (r) PDUEDATA - reference to return array
; (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
; (o) SORTED - Return the list of DUE in Alphabetical Order
;
;Output: Populated PDUEDATA array. This is a sub-multiple data so each row of the array is one sequence number
; PDUEDATA(n)=Seguence number^DUE Service Reason Code^DUE Professional Service Code^DUE Coagent Qualifier
; ^DUE Clinical Significance Code^DUE Co-Agent Description^DUE Acknowledgement Reason
;
Q:'$D(^PS(52.49,+$G(ERXIEN),0))
K PDUEDATA
;
N DATA,ALRARRAY,MEDIEN
S MEDIEN=$O(^PS(52.49,ERXIEN,311,0)) I 'MEDIEN Q
D GETS^DIQ(52.49311,MEDIEN_","_ERXIEN,"6*","IE","DATA") M ALRARRAY=DATA(52.493116)
;
N EXSEQ,INDEX,TMPDATA,COUNT
S EXSEQ=""
F S EXSEQ=$O(ALRARRAY(EXSEQ)) Q:EXSEQ="" D
. S INDEX=$S($G(SORTED):ALRARRAY(EXSEQ,1,"E")_" "_EXSEQ,1:EXSEQ)
. S $P(TMPDATA(INDEX),U,1)=ALRARRAY(EXSEQ,.01,"E")
. S $P(TMPDATA(INDEX),U,2)=ALRARRAY(EXSEQ,.02,"E")
. S $P(TMPDATA(INDEX),U,3)=ALRARRAY(EXSEQ,.03,"E")
. S $P(TMPDATA(INDEX),U,4)=ALRARRAY(EXSEQ,.04,"E")
. S $P(TMPDATA(INDEX),U,5)=ALRARRAY(EXSEQ,.05,"E")
. S $P(TMPDATA(INDEX),U,6)=ALRARRAY(EXSEQ,.06,"E")
. S $P(TMPDATA(INDEX),U,7)=ALRARRAY(EXSEQ,.07,"E")
. S $P(TMPDATA(INDEX),U,8)=ALRARRAY(EXSEQ,1,"E")
. S $P(TMPDATA(INDEX),U,9)=ALRARRAY(EXSEQ,2,"E")
S EXSEQ="",COUNT=0
F S EXSEQ=$O(TMPDATA(EXSEQ)) Q:EXSEQ="" D
. S COUNT=COUNT+1,PDUEDATA(COUNT)=TMPDATA(EXSEQ)
Q
;
CHVAELIG(DFN) ; Returns whether the VistA Patient is ChampVA Eligible or not (Used by MbM sites only)
; Input: DFN - Pointer to the PATIENT file (#2)
;Output: 1: ChampVA Eligible | 0: Unable to Verify or Not Eligibile
I $$GET1^DIQ(59.7,1,102,"I")'="MBM" Q "0^NOT AN MbM SITE"
N MBMELAPI,EXEC,ELIG S MBMELAPI="CHVAELIG^PSOZRXU0"
I $T(@MBMELAPI)="" Q "0^UNABLE TO VERIFY"
S EXEC="S ELIG=$$"_MBMELAPI_"("_DFN_")" X EXEC
Q $S(ELIG=1:"1^ELIGIBLE",ELIG=2:"2^SB",1:"0^NOT ELIGIBLE")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXU9 9717 printed Oct 16, 2024@18:29:49 Page 2
PSOERXU9 ;ALB/ART - eRx Holding Queue Utilities ;02/02/2021
+1 ;;7.0;OUTPATIENT PHARMACY;**617,700,746**;DEC 1997;Build 106
+2 ;
ERXIEN(RXIEN) ;Pass through to $$ERXIEN^PSOERXUT
+1 ; Input: (r) RXIEN - Pointer to either the PENDING ORDERS file (#52.41) (e.g., "139839P") or PRESCRIPTION file (#52) (e.g., 12930984)
+2 ;Returns: Pointer to the ERX HOLDING QUEUE file (#52.49) or "" (Not an eRx prescription)
+3 ;
+4 IF $GET(RXIEN)=""
if ""
QUIT
+5 QUIT $$ERXIEN^PSOERXUT(RXIEN)
+6 ;
CHKERX(ORDERIEN) ;Pass through to $$CHKERX^PSOERXU1
+1 ; Input: (r) ORDERIEN - Order (100) file IEN
+2 ;Returns: Pointer to the ERX HOLDING QUEUE file (#52.49) or 0 (Not an eRx prescription)
+3 ;
+4 IF $GET(ORDERIEN)=""
if 0
QUIT
+5 QUIT $$CHKERX^PSOERXU1(ORDERIEN)
+6 ;
ERXPATDFN(ERXIEN) ;Get patient DFN from eRx Holding Queue (52.49)
+1 ; Input: (r) ERXIEN - eRx Holding Queue IEN
+2 ;Returns: patient DFN from eRx Holding Queue
+3 ; or 0, if not found
+4 ;
+5 IF $GET(ERXIEN)=""
if 0
QUIT
+6 QUIT +$$GET1^DIQ(52.49,ERXIEN,.04,"I")
+7 ;
ERXPATDOB(ERXDFN) ;Get patient DoB from ERX External Patient (52.46)
+1 ; Input: (r) ERXDFN - patient DFN from eRx Holding Queue (52.49)
+2 ;Returns: patient DoB from ERX External Patient (52.46)
+3 ; or null
+4 ;
+5 IF $GET(ERXDFN)=""
if ""
QUIT
+6 QUIT $$FMTE^XLFDT($$GET1^DIQ(52.46,ERXDFN,.08,"I"),"5DZ")
+7 ;
ERXHUBID(ERXIEN) ;Get ERX HUB ID (.01) from eRx Holding Queue (52.49)
+1 ; Input: (r) ERXIEN - eRx Holding Queue IEN
+2 ;Returns: ERX HUB ID
+3 ; or null
+4 ;
+5 IF $GET(ERXIEN)=""
if ""
QUIT
+6 QUIT $SELECT(ERXIEN:$$GET1^DIQ(52.49,ERXIEN,.01),1:"")
+7 ;
ERXDATA(ERXDATA,ERXIEN) ;Get eRx Holding Queue Data
+1 ;Inputs: (r) ERXDATA - reference to return array
+2 ; (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
+3 ;Output: Populated ERXDATA array
+4 ; ERXDATA(1)=null ^ eRxReceivedDate(FileMan) ^ eRxDrugName ^ VistaDrugIEN ^ CSdrugSchedule ^ eRxQuantity ^ eRxRefill ^ eRxHubID
+5 ; ERXDATA(2)=providerDEA# ^ null ^ providerName ^ providerDUZ
+6 ; ERXDATA(3)=null ^ provStreet1 ^ provCity ^ provState ^ provZip
+7 ; ERXDATA(4)=patientName ^ patientDFN
+8 ; ERXDATA(5)=patStreet1 ^ patStreet2 ^ null ^ patCity ^ patState ^ patZip ^ patDOB(MM/DD/YYYY)
+9 ;
+10 if '$GET(ERXIEN)
QUIT
+11 if '$DATA(^PS(52.49,ERXIEN,0))
QUIT
+12 KILL ERXDATA
+13 ;get eRx Holding Queue fields
+14 NEW ERXHQ,ERR
+15 NEW ERXIENS
SET ERXIENS=ERXIEN_","
+16 DO GETS^DIQ(52.49,ERXIENS,".01;.03;.04;.05;2.1;2.3;2.5;3.1;3.2;4.9;5.1;5.6","EI","ERXHQ","ERR")
+17 ;eRx Hub ID
NEW HUBID
SET HUBID=$GET(ERXHQ(52.49,ERXIENS,.01,"I"))
+18 ;eRx Received Date
NEW RCVDDATE
SET RCVDDATE=$GET(ERXHQ(52.49,ERXIENS,.03,"I"))
+19 ;eRx External Patient ID
NEW EXPATIEN
SET EXPATIEN=$GET(ERXHQ(52.49,ERXIENS,.04,"I"))
+20 ;eRx External Patient VistA DFN
NEW EXPATDFN
SET EXPATDFN=$GET(ERXHQ(52.49,ERXIENS,.05,"I"))
+21 ;eRx External Provider ID
NEW EXPRVIEN
SET EXPRVIEN=$GET(ERXHQ(52.49,ERXIENS,2.1,"I"))
+22 ;eRx External Provider VistA ID
NEW EXPRVDUZ
SET EXPRVDUZ=$GET(ERXHQ(52.49,ERXIENS,2.3,"I"))
+23 ;eRx External Pharmacy ID
NEW EXPHID
SET EXPHID=$GET(ERXHQ(52.49,ERXIENS,2.5,"I"))
+24 ;eRx Generic name
NEW DRUGNAME
SET DRUGNAME=$GET(ERXHQ(52.49,ERXIENS,3.1,"I"))
+25 ;eRx Drug IEN
NEW DRUGIEN
SET DRUGIEN=$GET(ERXHQ(52.49,ERXIENS,3.2,"I"))
+26 ;eRx DEA Schedule
NEW EXDEA
SET EXDEA=$GET(ERXHQ(52.49,ERXIENS,4.9,"E"))
+27 SET EXDEA=$SELECT(EXDEA="C48672":1,EXDEA="C48675":2,EXDEA="C48676":3,EXDEA="C48677":4,EXDEA="C48679":5,1:"")
+28 ;eRx Quantity
NEW ERXQUANT
SET ERXQUANT=$GET(ERXHQ(52.49,ERXIENS,5.1,"E"))
+29 ;eRx Refills
NEW ERXREFIL
SET ERXREFIL=$GET(ERXHQ(52.49,ERXIENS,5.6,"E"))
+30 ;get eRx External Pharmacy fields
+31 NEW ERXPHARM,ERR
+32 NEW EXPHIDS
SET EXPHIDS=EXPHID_","
+33 DO GETS^DIQ(52.47,EXPHIDS,".01;.04;1.1;1.3;1.4;1.5","EI","ERXPHARM","ERR")
+34 ;eRx pharmacy name
NEW PHNAME
SET PHNAME=$GET(ERXPHARM(52.47,EXPHIDS,.01,"E"))
+35 ;eRx pharmacy dea number
NEW PHDEA
SET PHDEA=$GET(ERXPHARM(52.47,EXPHIDS,.04,"E"))
+36 ;eRx pharmacy address line 1
NEW PHSTREET
SET PHSTREET=$GET(ERXPHARM(52.47,EXPHIDS,1.1,"E"))
+37 ;eRx pharmacy city
NEW PHCITY
SET PHCITY=$GET(ERXPHARM(52.47,EXPHIDS,1.3,"E"))
+38 ;eRx pharmacy state
NEW PHSTATE
SET PHSTATE=$GET(ERXPHARM(52.47,EXPHIDS,1.4,"E"))
+39 ;eRx pharmacy zip
NEW PHZIP
SET PHZIP=$GET(ERXPHARM(52.47,EXPHIDS,1.5,"E"))
+40 ;get eRx External Provider fields
+41 NEW ERXPROV,ERR
+42 NEW EXPRVIENS
SET EXPRVIENS=EXPRVIEN_","
+43 DO GETS^DIQ(52.48,EXPRVIENS,".01;1.6;4.1;4.2;4.3;4.4;4.5","EI","ERXPROV","ERR")
+44 ;eRx provider name
NEW PROVNAME
SET PROVNAME=$GET(ERXPROV(52.48,EXPRVIENS,.01,"E"))
+45 ;eRx provider dea#
NEW PRVDEANBR
SET PRVDEANBR=$GET(ERXPROV(52.48,EXPRVIENS,1.6,"E"))
+46 ;eRx provider street 1
NEW PRVSTR1
SET PRVSTR1=$GET(ERXPROV(52.48,EXPRVIENS,4.1,"E"))
+47 ;eRx provider street 2
NEW PRVSTR2
SET PRVSTR2=$GET(ERXPROV(52.48,EXPRVIENS,4.2,"E"))
+48 ;eRx provider city
NEW PRVCITY
SET PRVCITY=$GET(ERXPROV(52.48,EXPRVIENS,4.3,"E"))
+49 ;eRx provider state
NEW PRVSTATE
SET PRVSTATE=$GET(ERXPROV(52.48,EXPRVIENS,4.4,"E"))
+50 ;eRx provider zip
NEW PRVZIP
SET PRVZIP=$GET(ERXPROV(52.48,EXPRVIENS,4.5,"E"))
+51 ;get eRx External Patient fields
+52 NEW ERXPAT,ERR
+53 NEW EXPATIENS
SET EXPATIENS=EXPATIEN_","
+54 DO GETS^DIQ(52.46,EXPATIENS,".01;.08;1.5;3.1;3.2;3.3;3.4;3.5","EI","ERXPAT","ERR")
+55 ;eRx patient name
NEW PATNAME
SET PATNAME=$GET(ERXPAT(52.46,EXPATIENS,.01,"E"))
+56 ;eRx patient DoB
NEW PATDOB
SET PATDOB=$GET(ERXPAT(52.46,EXPATIENS,.08,"I"))
+57 ;eRx patient dfn
NEW PATDFN
SET PATDFN=$GET(ERXPAT(52.46,EXPATIENS,1.5,"E"))
+58 ;eRx street 1
NEW PATSTR1
SET PATSTR1=$GET(ERXPAT(52.46,EXPATIENS,3.1,"E"))
+59 ;eRx street 2
NEW PATSTR2
SET PATSTR2=$GET(ERXPAT(52.46,EXPATIENS,3.2,"E"))
+60 ;eRx city
NEW PATCITY
SET PATCITY=$GET(ERXPAT(52.46,EXPATIENS,3.3,"E"))
+61 ;eRx state
NEW PATSTATE
SET PATSTATE=$GET(ERXPAT(52.46,EXPATIENS,3.4,"E"))
+62 ;eRx zip
NEW PATZIP
SET PATZIP=$GET(ERXPAT(52.46,EXPATIENS,3.5,"E"))
+63 ;
+64 SET ERXDATA(1)=U_RCVDDATE_U_DRUGNAME_U_DRUGIEN_U_EXDEA_U_ERXQUANT_U_ERXREFIL_U_HUBID
+65 SET ERXDATA(2)=PRVDEANBR_U_U_PROVNAME_U_EXPRVDUZ
+66 SET ERXDATA(3)=U_PRVSTR1_U_PRVCITY_U_PRVSTATE_U_PRVZIP
+67 SET ERXDATA(4)=PATNAME_U_EXPATDFN
+68 SET ERXDATA(5)=PATSTR1_U_PATSTR2_U_""_U_PATCITY_U_PATSTATE_U_PATZIP_U_$$FMTE^XLFDT(PATDOB,"5DZ")
+69 ;
+70 QUIT
+71 ;
ALRGDATA(ALRGDATA,ERXIEN,SORTED) ; Get eRx Patient Allergy Data
+1 ;Inputs: (r) ALRGDATA - reference to return array
+2 ; (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
+3 ; (o) SORTED - Return the list of Allergies in Alphabetical Order
+4 ;
+5 ;Output: Populated ALRGDATA array. This is a sub-multiple data so each row of the array is one sequence number
+6 ; ALRGDATA(n)=Seguence number^Source of information^Effective date^Expiration date^Drug product code^Drug product qualifier
+7 ; ^Drug product text^Reaction text^reaction code^Severity text^Severity code^Adverse event text^Adverse event code
+8 ;
+9 if '$DATA(^PS(52.49,+$GET(ERXIEN),0))
QUIT
+10 KILL ALRGDATA
+11 ;
+12 NEW DATA,ALRARRAY
+13 DO GETS^DIQ(52.49,ERXIEN,"303*","IE","DATA")
MERGE ALRARRAY=DATA(52.49303)
+14 ;
+15 NEW EXSEQ,INDEX,TMPDATA,COUNT
+16 SET EXSEQ=""
+17 FOR
SET EXSEQ=$ORDER(ALRARRAY(EXSEQ))
if EXSEQ=""
QUIT
Begin DoDot:1
+18 SET INDEX=$SELECT($GET(SORTED):ALRARRAY(EXSEQ,3,"E")_" "_EXSEQ,1:EXSEQ)
+19 SET $PIECE(TMPDATA(INDEX),U,1)=ALRARRAY(EXSEQ,.01,"E")
+20 SET $PIECE(TMPDATA(INDEX),U,2)=ALRARRAY(EXSEQ,.02,"E")
+21 SET $PIECE(TMPDATA(INDEX),U,3)=ALRARRAY(EXSEQ,.03,"I")
+22 SET $PIECE(TMPDATA(INDEX),U,4)=ALRARRAY(EXSEQ,.04,"E")
+23 SET $PIECE(TMPDATA(INDEX),U,5)=ALRARRAY(EXSEQ,1,"E")
+24 SET $PIECE(TMPDATA(INDEX),U,6)=ALRARRAY(EXSEQ,2,"E")
+25 SET $PIECE(TMPDATA(INDEX),U,7)=ALRARRAY(EXSEQ,3,"E")
+26 SET $PIECE(TMPDATA(INDEX),U,8)=ALRARRAY(EXSEQ,4,"E")
+27 SET $PIECE(TMPDATA(INDEX),U,9)=ALRARRAY(EXSEQ,5,"E")
+28 SET $PIECE(TMPDATA(INDEX),U,10)=ALRARRAY(EXSEQ,6,"E")
+29 SET $PIECE(TMPDATA(INDEX),U,11)=ALRARRAY(EXSEQ,7,"E")
+30 SET $PIECE(TMPDATA(INDEX),U,12)=ALRARRAY(EXSEQ,8,"E")
+31 SET $PIECE(TMPDATA(INDEX),U,13)=ALRARRAY(EXSEQ,9,"E")
End DoDot:1
+32 SET EXSEQ=""
SET COUNT=0
+33 FOR
SET EXSEQ=$ORDER(TMPDATA(EXSEQ))
if EXSEQ=""
QUIT
Begin DoDot:1
+34 SET COUNT=COUNT+1
SET ALRGDATA(COUNT)=TMPDATA(EXSEQ)
End DoDot:1
+35 QUIT
+36 ;
PDUEDATA(PDUEDATA,ERXIEN,SORTED) ; Get eRx Prescriber Drug Use Evaluation Data
+1 ;Inputs: (r) PDUEDATA - reference to return array
+2 ; (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
+3 ; (o) SORTED - Return the list of DUE in Alphabetical Order
+4 ;
+5 ;Output: Populated PDUEDATA array. This is a sub-multiple data so each row of the array is one sequence number
+6 ; PDUEDATA(n)=Seguence number^DUE Service Reason Code^DUE Professional Service Code^DUE Coagent Qualifier
+7 ; ^DUE Clinical Significance Code^DUE Co-Agent Description^DUE Acknowledgement Reason
+8 ;
+9 if '$DATA(^PS(52.49,+$GET(ERXIEN),0))
QUIT
+10 KILL PDUEDATA
+11 ;
+12 NEW DATA,ALRARRAY,MEDIEN
+13 SET MEDIEN=$ORDER(^PS(52.49,ERXIEN,311,0))
IF 'MEDIEN
QUIT
+14 DO GETS^DIQ(52.49311,MEDIEN_","_ERXIEN,"6*","IE","DATA")
MERGE ALRARRAY=DATA(52.493116)
+15 ;
+16 NEW EXSEQ,INDEX,TMPDATA,COUNT
+17 SET EXSEQ=""
+18 FOR
SET EXSEQ=$ORDER(ALRARRAY(EXSEQ))
if EXSEQ=""
QUIT
Begin DoDot:1
+19 SET INDEX=$SELECT($GET(SORTED):ALRARRAY(EXSEQ,1,"E")_" "_EXSEQ,1:EXSEQ)
+20 SET $PIECE(TMPDATA(INDEX),U,1)=ALRARRAY(EXSEQ,.01,"E")
+21 SET $PIECE(TMPDATA(INDEX),U,2)=ALRARRAY(EXSEQ,.02,"E")
+22 SET $PIECE(TMPDATA(INDEX),U,3)=ALRARRAY(EXSEQ,.03,"E")
+23 SET $PIECE(TMPDATA(INDEX),U,4)=ALRARRAY(EXSEQ,.04,"E")
+24 SET $PIECE(TMPDATA(INDEX),U,5)=ALRARRAY(EXSEQ,.05,"E")
+25 SET $PIECE(TMPDATA(INDEX),U,6)=ALRARRAY(EXSEQ,.06,"E")
+26 SET $PIECE(TMPDATA(INDEX),U,7)=ALRARRAY(EXSEQ,.07,"E")
+27 SET $PIECE(TMPDATA(INDEX),U,8)=ALRARRAY(EXSEQ,1,"E")
+28 SET $PIECE(TMPDATA(INDEX),U,9)=ALRARRAY(EXSEQ,2,"E")
End DoDot:1
+29 SET EXSEQ=""
SET COUNT=0
+30 FOR
SET EXSEQ=$ORDER(TMPDATA(EXSEQ))
if EXSEQ=""
QUIT
Begin DoDot:1
+31 SET COUNT=COUNT+1
SET PDUEDATA(COUNT)=TMPDATA(EXSEQ)
End DoDot:1
+32 QUIT
+33 ;
CHVAELIG(DFN) ; Returns whether the VistA Patient is ChampVA Eligible or not (Used by MbM sites only)
+1 ; Input: DFN - Pointer to the PATIENT file (#2)
+2 ;Output: 1: ChampVA Eligible | 0: Unable to Verify or Not Eligibile
+3 IF $$GET1^DIQ(59.7,1,102,"I")'="MBM"
QUIT "0^NOT AN MbM SITE"
+4 NEW MBMELAPI,EXEC,ELIG
SET MBMELAPI="CHVAELIG^PSOZRXU0"
+5 IF $TEXT(@MBMELAPI)=""
QUIT "0^UNABLE TO VERIFY"
+6 SET EXEC="S ELIG=$$"_MBMELAPI_"("_DFN_")"
XECUTE EXEC
+7 QUIT $SELECT(ELIG=1:"1^ELIGIBLE",ELIG=2:"2^SB",1:"0^NOT ELIGIBLE")
