- 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 Feb 18, 2025@23:55:36 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")