PSOASAP0 ;BIRM/MFR - American Society for Automation in Pharmacy (ASAP) Segments & Fields ;09/07/12
;;7.0;OUTPATIENT PHARMACY;**408,451,496,504,625,630,659,705**;DEC 1997;Build 5
;External reference to $$NATURE^ORUTL3 supported by DBIA 5890
;External reference to ^ORDEA is supported by DBIA 5709
;External reference to PATIENT file (#2) supported by DBIA 5597
;External reference to $$NPI^XUSNPI supported by DBIA 4532
;External reference to $$DIV4^XUSER supported by DBIA 2533
;
; ******************** ASAP 1995 Version ********************
ASAP95(RXIEN,FILL) ;Returns the entire ASAP 1995 record for the Rx/Fill
;Input: (r) RXIEN - Rx IEN (#52)
; (r) FILL - Fill #
N ASAP95,RXNUM
S RXNUM=$E(RXIEN+10000000,$L(RXIEN+10000000)-6,$L(RXIEN+10000000))
S $E(ASAP95,1,3)="ASB" ;Transmission Type Identifier
S $E(ASAP95,4,9)="VA"_$E(10000+$$SITE^VASITE(),2,5) ;Bank Identification Number
S $E(ASAP95,10,11)="A2" ;ASAP Version (A2 = 1995)
S $E(ASAP95,12,13)="01" ;Transaction Code ("01" - Controlled Substance)
S $E(ASAP95,14,25)=$E($$PHA03^PSOASAP(),1,12) ;Pharmacy DEA# Number
S $E(ASAP95,26,45)=$$PAT03^PSOASAP() ;Patient ID (SSN)
S $E(ASAP95,46,48)=$E($$PAT16^PSOASAP(),1,3) ;Patient's Zip Code (first 3 digits)
S $E(ASAP95,49,56)=$$PAT18^PSOASAP() ;Patient's DOB (Format: YYYYMMDD)
S $E(ASAP95,57,57)=$S($$PAT19^PSOASAP()="M":1,1:"2") ;Patient's Gender
S $E(ASAP95,58,65)=$$DSP05^PSOASAP() ;Date Filled (Release/RTS Date) (Format: YYYYMMDD)
S $E(ASAP95,66,72)=RXNUM ;Prescription Number (IEN - Because it must be 7-digit numeric )
S $E(ASAP95,73,74)=$E(FILL+100,2,3) ;Fill Number
S $E(ASAP95,75,79)=$E(100000+$$DSP09^PSOASAP(),2,6) ;Quantity
S $E(ASAP95,80,82)=$E(1000+$$DSP10^PSOASAP(),2,4) ;Days Supply
S $E(ASAP95,83,83)="1" ;Compound Flag (1=Not compound)
S $E(ASAP95,84,94)=$E($$DSP08^PSOASAP(),1,11) ;NDC (Fomart: 99999999999)
S $E(ASAP95,95,104)=$E($$PRE02^PSOASAP(),1,10) ;Prescriber's DEA #
S $E(ASAP95,105,108)="" ;DEA Suffix
S $E(ASAP95,109,116)=$$DSP03^PSOASAP() ;Date Written (Format: YYYYMMDD)
S $E(ASAP95,117,118)=$E(100+$$DSP04^PSOASAP(),2,3) ;Refills Authorized
S $E(ASAP95,119,119)=$S(+$$DSP12^PSOASAP()>2:0,1:+$$DSP12^PSOASAP()) ;Rx Origin Code (0:Not Specified/1:Written/2:Telephone)
S $E(ASAP95,120,121)="03" ;Customer Location (Always: "03" - Outpatient)
S $E(ASAP95,122,128)="" ;DEA Suffix
S $E(ASAP95,129,138)=$E($$PRE03^PSOASAP(),1,10) ;Alternate Prescriber # (VA #)
S $E(ASAP95,139,153)=$E($$PAT07^PSOASAP(),1,15) ;Patient's Last Name
S $E(ASAP95,154,168)=$E($$PAT08^PSOASAP(),1,15) ;Patient's First Name
S $E(ASAP95,169,198)=$E($$PAT12^PSOASAP(),1,30) ;Patient's Address
S $E(ASAP95,199,200)=$E($$PAT15^PSOASAP(),1,2) ;Patient's State
S $E(ASAP95,201,209)=$E($$PAT16^PSOASAP(),1,9) ;Patient's Zip Code
S $E(ASAP95,210,222)="" ;Filler
Q ASAP95
;
; ******************** ASAP 3.0 and above versions ********************
; *** TH Segment ***
TH02() ;ASAP 3.0 : Business Partner Implemetation Version (Not Used)
; ASAP 4.0+: Transaction Control Number
I PSOASVER="3.0" Q ""
Q +$$SITE^VASITE()_"-"_+$G(BATCHIEN)
;
TH03() ;ASAP 3.0 : Transaction Control Number
; ASAP 4.0+: Transaction Type (Always "01" - Send/Request Transaction)
I PSOASVER="3.0" Q +$$SITE^VASITE()_"-"_+$G(BATCHIEN)
Q "01"
;
TH05() ;ASAP 3.0 : Message Type (Not Used)
; ASAP 4.0+: Creation Date (Format: YYYYMMDD)
I PSOASVER="3.0" Q ""
Q $$FMTHL7^XLFDT($$HTFM^XLFDT($H)\1)
;
TH06() ;ASAP 3.0 : Response ID (Not Used)
; ASAP 4.0+: Creation Time. Format: HHMMSS or HHMM
I PSOASVER="3.0" Q ""
Q $E($P($$HTFM^XLFDT($H),".",2)_"000000",1,6)
;
TH07() ;ASAP 3.0 : Project ID (Not Used)
; ASAP 4.0+: File Type. Returns: "T" - Test or "P" - Production
I PSOASVER="3.0" Q ""
Q $S($$PROD^XUPROD(1):"P",1:"T")
;
TH08() ;ASAP 3.0: Creation Date (Format: YYYYMMDD)
; ASAP 4.0: Composite Element Separator (:)
; ASAP 4.1+: Routing Number (Real-time transactions only) - Not Used
I PSOASVER="4.0" Q ":"
I PSOASVER'="3.0" Q ""
Q $$FMTHL7^XLFDT($$HTFM^XLFDT($H)\1)
;
TH09() ;ASAP 3.0 : Creation Time. Format: HHMMSS or HHMM
; ASAP 4.1+: Segment Terminator Character
I PSOASVER="3.0" Q $E($P($$HTFM^XLFDT($H),".",2)_"000000",1,6)
Q $P($$VERDATA^PSOSPMU0(PSOASVER,"B"),"^",3)
;
TH10() ;ASAP 3.0 : File Type
; ASAP 4.0+: N/A
I PSOASVER="3.0" Q $S($$PROD^XUPROD(1):"P",1:"T")
Q ""
;
TH12() ;ASAP 3.0 : Composite Element Separator
; ASAP 4.0+: N/A
I PSOASVER="3.0" Q ":"
Q ""
;
TH13() ;ASAP 3.0 : Data Segment Terminator Character
; ASAP 4.0+: N/A
I PSOASVER'="3.0" Q ""
Q $P($$VERDATA^PSOSPMU0(PSOASVER,"B"),"^",3)
;
; *** PHA Segment ***
PHA01() ;National Provider Identifier
N NPINST,NPINUM
S NPINST=$$GET1^DIQ(59,SITEIEN,101,"I") I 'NPINST Q ""
S NPINUM=+$$NPI^XUSNPI("Organization_ID",NPINST,DT)
Q $S(NPINUM>0:NPINUM,1:"")
;
PHA03() ;Pharmacy DEA Number
N PHA03,INST
;Primary source: Pharmacy NPI Institution
S PHA03="",INST=$$GET1^DIQ(59,SITEIEN,101,"I")
I INST S PHA03=$$WHAT^XUAF4(INST,52)
;Backup source: Pharmacy Related Institution
I PHA03="" D
. S INST=$$GET1^DIQ(59,SITEIEN,100,"I")
. I INST S PHA03=$$WHAT^XUAF4(INST,52)
Q PHA03
;
PHA10() ;Phone Number
Q $$PHONE($$GET1^DIQ(59,SITEIEN,.03)_$$GET1^DIQ(59,SITEIEN,.04))
;
; *** PAT Segment ***
PAT03() ;ASAP 3.0 : Unique System ID - Patient (Not Used)
; ASAP 4.0+: ID of Patient (SSN)
I PSOASVER="3.0" Q ""
Q $P($G(VADM(2)),"^",1)
;
PAT04() ;ASAP 3.0 : SSN
; ASAP 4.0+: ID Qualifier of Additional Patient Identifier (Not Used)
I PSOASVER="3.0" Q $P($G(VADM(2)),"^",1)
Q ""
;
PAT12() ;Patient Address Information - Line 1
; ASAP 4.2: Length = 35 characters (All others: 30 characters)
N ADDRESS
I PSOASVER="4.2" D Q ADDRESS
. S ADDRESS=$S($G(VAPA(1))'="":VAPA(1),$G(VAPA(11)):"STREET ADDRESS UNKNOWN",1:"")
S ADDRESS=$$TRIM^XLFSTR($G(VAPA(1)))_$S($$TRIM^XLFSTR($G(VAPA(2)))'="":" "_VAPA(2),1:"")_$S($$TRIM^XLFSTR($G(VAPA(3)))'="":" "_VAPA(3),1:"")
I ADDRESS="",$G(VAPA(11)) S ADDRESS="STREET ADDRESS UNKNOWN"
I $E(ADDRESS,1,30)'[" " Q $E(ADDRESS,1,30)
Q $$ADDRESS(ADDRESS,1)
;
PAT13() ;Patient Address Information - Line 2
; ASAP 4.2: Length = 35 characters (All others: 30 characters)
I PSOASVER="4.2" Q $G(VAPA(2))
N ADDRESS
S ADDRESS=$$TRIM^XLFSTR($G(VAPA(1)))_$S($$TRIM^XLFSTR($G(VAPA(2)))'="":" "_VAPA(2),1:"")_$S($$TRIM^XLFSTR($G(VAPA(3)))'="":" "_VAPA(3),1:"")
I $E(ADDRESS,1,30)'[" " Q $E(ADDRESS,31,999)
Q $$ADDRESS(ADDRESS,2)
;
PAT15() ;Patient State Address
; US State Abbreviation
I $$PAT22()="" Q $$GET1^DIQ(5,+$G(VAPA(5)),1)
; International State/Province
Q $P($G(VAPA(23)),"^")
;
PAT16() ;Patient ZIP Code
; US Zip Code
I $$PAT22()="" Q $TR($P($G(VAPA(11)),"^",1),"-")
; International Postal Code
Q $P($G(VAPA(24)),"^")
;
PAT17() ;Patient Phone Number
N PAT17
;PHONE NUMBER [RESIDENCE] (Home)
S PAT17=$$PHONE($P($G(VAPA(8)),"^",1)) I PAT17 Q PAT17
;PHONE NUMBER [CELLULAR] (Cell)
S PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.134)) I PAT17 Q PAT17
;PHONE NUMBER [WORK] (Work)
S PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.132)) I PAT17 Q PAT17
;K-WORK PHONE NUMBER (Next Of Kin)
S PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.21011)) I PAT17 Q PAT17
;K2-WORK PHONE NUMBER (Secondary Next Of Kin)
S PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.211011)) I PAT17 Q PAT17
;E-WORK PHONE NUMBER (Work Emergency)
S PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.33011)) I PAT17 Q PAT17
;E2-WORK PHONE NUMBER (Secondary Work Emergency)
S PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.331011)) I PAT17 Q PAT17
;Last resort: Pharmacy Phone #
Q $$PHA10()
;
PAT18() ;ASAP 3.0 : Email Address (Not Used)
; ASAP 4.0+: Patient DOB
I PSOASVER="3.0" Q ""
Q $$FMTHL7^XLFDT($P($G(VADM(3)),"^",1))
;
PAT19() ;ASAP 3.0 : Patient DOB
; ASAP 4.0+: Patient Gender Code
I PSOASVER="3.0" Q $$FMTHL7^XLFDT($P($G(VADM(3)),"^",1))
Q $S($P($G(VADM(5)),"^",1)'="":$P($G(VADM(5)),"^",1),1:"U")
;
PAT20() ;ASAP 3.0 : Patient Gender Code
; ASAP 4.0+: Species Code (Always return "01" for 'Human')
I PSOASVER="3.0" Q $S($P($G(VADM(5)),"^",1)'="":$P($G(VADM(5)),"^",1),1:"U")
Q "01"
;
PAT22() ;ASAP 3.0 : Primary Prescription Coverage Type (Not Used)
; ASAP 4.0+:Country of Non-U.S. Resident
I PSOASVER="3.0" Q ""
N CNTRYIEN,FIPSCODE
S CNTRYIEN=+$G(VAPA(25)) I 'CNTRYIEN Q ""
S FIPSCODE=$$GET1^DIQ(779.004,CNTRYIEN,1.2)
Q $S(FIPSCODE="US":"",FIPSCODE="CA":"CN",1:FIPSCODE)
;
; *** RX Segment (ASAP 3.0 only) ***
RX08() ;Date Rx Written (Format: YYYYMMDD)
N RX08
S RX08=$$GET1^DIQ(52,+$G(RXIEN),1,"I")
; Date Rx Written (ISSUE DATE) cannot be in the future or after Rx Fill Date (Use LOGIN DATE instead)
I RX08>DT!(RX08>$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)) D
. S RX08=$$GET1^DIQ(52,+$G(RXIEN),21,"I")\1
Q $$FMTHL7^XLFDT(RX08)
;
RX14() ;Product ID (NDC - National Drug Code)
N RX14 S RX14=""
I RECTYPE="V",$G(RTSDATA("NDC"))'="" S RX14=$$NUMERIC(RTSDATA("NDC"))
I 'RX14 S RX14=$$NUMERIC($$GET1^DIQ(50,DRUGIEN,31))
I 'RX14 S RX14=$$NUMERIC($$GETNDC^PSONDCUT(RXIEN,+FILLNUM))
Q RX14
;
; *** DSP Segment ***
DSP01() ;ASAP 3.0 : Reporting Status ("01" - Add / "02" - Change / "03" - Delete)
; ASAP 4.0 : Reporting Status ("" - New / "01" - Revise / "02" - Void)
; ASAP 4.1+: Reporting Status ("00" - New / "01" - Revise / "02" - Void)
I PSOASVER="3.0" Q $S($G(RECTYPE)="N":"01",$G(RECTYPE)="R":"02",$G(RECTYPE)="V":"03",1:"")
I PSOASVER="4.0",RECTYPE="N" Q ""
Q $S($G(RECTYPE)="N":"00",$G(RECTYPE)="R":"01",$G(RECTYPE)="V":"02",1:"")
;
DSP02() ;ASAP 3.0 : Program Participation Status (Not Used)
; ASAP 4.0+: Prescription Number
I PSOASVER="3.0" Q ""
Q $$GET1^DIQ(52,+$G(RXIEN),.01)
;
DSP03() ;ASAP 3.0 : Prescription Number
; ASAP 4.0+: Date Rx Written (Format: YYYYMMDD)
I PSOASVER="3.0" Q $$GET1^DIQ(52,+$G(RXIEN),.01)
N DSP03
S DSP03=$$GET1^DIQ(52,+$G(RXIEN),1,"I")
; Date Rx Written (ISSUE DATE) cannot be in the future or after Rx Fill Date (Use LOGIN DATE instead)
I DSP03>DT!(DSP03>$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)) D
. S DSP03=$$GET1^DIQ(52,+$G(RXIEN),21,"I")\1
Q $$FMTHL7^XLFDT(DSP03)
;
DSP04() ;ASAP 3.0 : Refill Number
; ASAP 4.0+: Refills Authorized
I PSOASVER="3.0" Q +FILLNUM
Q +$$GET1^DIQ(52,+$G(RXIEN),9)
;
DSP05() ;ASAP 3.0 : Unique System ID - RPh (Not Used)
; ASAP 4.0+: Date Filled (Release Date) (Format: YYYYMMDD)
; ZERO RPT 4.0+: Date Report was created
I PSOASVER="3.0" Q ""
N DSP05
I $G(BATCHIEN),$$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR" S DSP05=$$GET1^DIQ(58.42,BATCHIEN,8,"I") Q $$FMTHL7^XLFDT((DSP05)\1)
S DSP05=$S((RECTYPE="V")&($G(RTSDATA("RELDTTM"))'=""):$G(RTSDATA("RELDTTM")),$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM):$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM),1:DT)\1
Q $S(DSP05:$$FMTHL7^XLFDT(DSP05),1:"")
;
DSP06() ;ASAP 3.0 : Unique System ID - Patient (Not Used)
; ASAP 4.0+: Refill Number (Partials are always "0")
I PSOASVER="3.0" Q ""
Q +FILLNUM
;
DSP07() ;ASAP 3.0 : Unique System ID - Prescriber (Not Used)
; ASAP 4.0+: Product ID Qualifier (Always return "01" for 'NDC')
I PSOASVER="3.0" Q ""
Q "01"
;
DSP08() ;ASAP 3.0 : Unique System ID - Drug (Not Used)
; ASAP 4.0+:Product ID (NDC - National Drug Code)
I PSOASVER="3.0" Q ""
N DSP08 S DSP08=""
I RECTYPE="V",$G(RTSDATA("NDC"))'="" S DSP08=$$NUMERIC(RTSDATA("NDC"))
I 'DSP08 S DSP08=$$NUMERIC($$GET1^DIQ(50,DRUGIEN,31))
I 'DSP08 S DSP08=$$NUMERIC($$GETNDC^PSONDCUT(RXIEN,+FILLNUM))
Q DSP08
;
DSP09() ;ASAP 3.0 : Date Filled
; ASAP 4.0+: Quantity Dispensed
N DSP09
I PSOASVER="3.0" D Q DSP09
. S DSP09=$S(RECTYPE="V":$G(RTSDATA("RELDTTM")),$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM):$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM),1:DT)\1
. S DSP09=$S(DSP09'="":$$FMTHL7^XLFDT(DSP09),1:"")
Q $S((RECTYPE="V")&($G(RTSDATA("QTY"))'=""):$G(RTSDATA("QTY")),1:$$RXQTY^PSOBPSUT(RXIEN,FILLNUM))
;
DSP10() ;ASAP 3.0 : Time Filled (Not Used)
; ASAP 4.0+: Days Supply
I PSOASVER="3.0" Q ""
Q $S((RECTYPE="V")&($G(RTSDATA("DAYSUP"))'=""):$G(RTSDATA("DAYSUP")),1:$$RXDAYSUP^PSOBPSUT(RXIEN,FILLNUM))
;
DSP11() ;ASAP 3.0 : Product ID Qualifier (01:NDC)
; ASAP 4.0+: Drug Dosage Units Code
I PSOASVER="3.0" Q "01"
N UNIT
S UNIT=$$GET1^DIQ(50,DRUGIEN,82,"I")
Q $S(UNIT="EA":"01",UNIT="ML":"02",UNIT="GM":"03",1:"")
;
DSP12() ;ASAP 3.0 : Product ID (NDC)
; ASAP 4.0+: Transmission Form of Rx Origin Code (Nature of Order)
N DSP12 S DSP12=""
I PSOASVER="3.0" D Q DSP12
. I RECTYPE="V",$G(RTSDATA("NDC"))'="" S DSP12=$$NUMERIC(RTSDATA("NDC"))
. I 'DSP12 S DSP12=$$NUMERIC($$GET1^DIQ(50,DRUGIEN,31))
. I 'DSP12 S DSP12=$$NUMERIC($$GETNDC^PSONDCUT(RXIEN,+FILLNUM))
N NOO,ORDNUM S NOO="W"
S ORDNUM=$$GET1^DIQ(52,RXIEN,39.3,"I")
I $G(ORDNUM) D
. S NOO=$P($$NATURE^ORUTL3(ORDNUM),"^",2)
Q $S(NOO="W":"01",(NOO="V")!(NOO="P"):"02",NOO="E":"05",1:"99")
;
DSP13() ;ASAP 3.0 : Product Description (Not Used)
; ASAP 4.0+: Partial Fill Indicator
I PSOASVER="3.0" Q ""
I PSOASVER="4.0"!(PSOASVER="4.1") Q $S(FILLNUM["P":"01",1:"02")
Q $S(FILLNUM["P":$E(100+$E(FILLNUM,2,3),2,3),1:"00")
;
DSP14() ;ASAP 3.0 : Quantity Dispensed
; ASAP 4.0+: Pharmacist National Provider Identifier (NPI)
I PSOASVER="3.0" Q $S(RECTYPE="V":$G(RTSDATA("QTY")),1:$$RXQTY^PSOBPSUT(RXIEN,FILLNUM))
N NPI
S NPI=+$$NPI^XUSNPI("Individual_ID",RPHIEN,DT)
Q $S(NPI>0:NPI,1:"")
;
DSP15() ;ASAP 3.0 : Days Supply
; ASAP 4.0+: Pharmacist State License Number (Not Used)
I PSOASVER="3.0" Q $S(RECTYPE="V":$G(RTSDATA("DAYSUP")),1:$$RXDAYSUP^PSOBPSUT(RXIEN,FILLNUM))
Q ""
;
DSP16() ;ASAP 3.0 : Basis of Days Supply Determiniation (Always "3" for 'As directed by doctor')
; ASAP 4.0+: Classification Code for Payment Type (Always return "05" for 'Military Installations and VA')
I PSOASVER="3.0" Q "3"
Q "05"
;
DSP17() ;ASAP 3.0 : Refills Remaining (Not Used)
; ASAP 4.0 : N/A
; ASAP 4.1+: Date Sold
I PSOASVER="3.0"!(PSOASVER="4.0") Q ""
Q $$DSP05()
;
; *** PRE Segment ***
PRE01() ;ASAP 3.0 : Not Used
; ASAP 4.0+: Prescriber National Provider Identifier (NPI)
I PSOASVER="3.0" Q ""
N PRE01
S PRE01=+$$NPI^XUSNPI("Individual_ID",PREIEN)
Q $S(PRE01>0:PRE01,1:"")
;
PRE02() ;Prescriber DEA Number
N PRE02,RXISSDT ;P705 RX Issue/Written Date
S RXISSDT=$$GET1^DIQ(52,+$G(RXIEN),1,"I")
S PRE02=$$PRVDEA() I PRE02'="" Q $P(PRE02,"-",1)
S PRE02=$P($$DEA^XUSER(0,PREIEN,RXISSDT),"-",1)
I (PRE02="")!($P($$DEA^XUSER(0,PREIEN,RXISSDT),"-",2,99)'="") S PRE02=$$PHA03()
Q PRE02
;
PRE03() ;ASAP 3.0 : Prescriber NPI
; ASAP 4.0+: Prescriber DEA Number Suffix
N PRE03
I PSOASVER="3.0" D Q PRE03
. S PRE03=+$$NPI^XUSNPI("Individual_ID",PREIEN)
. S PRE03=$S(PRE03>0:PRE03,1:"")
;
S PRE03=$$PRVDEA() I PRE03'="" Q $P(PRE03,"-",2,99)
S PRE03=$P($$DEA^XUSER(0,PREIEN),"-",2,99)
I $$PRE02()=$$PHA03() S PRE03=$P($$DEA^XUSER(1,PREIEN),"-",1)
Q PRE03
;
PRE04() ;ASAP 3.0 : Prescriber DEA Number
; ASAP 4.0+: Prescriber State License Number (Not Used)
I PSOASVER'="3.0" Q ""
;
N PRE04
S PRE04=$$PRVDEA() I PRE04'="" Q $P(PRE04,"-",1)
S PRE04=$P($$DEA^XUSER(0,PREIEN),"-",1)
I (PRE04="")!($P($$DEA^XUSER(0,PREIEN),"-",2,99)'="") S PRE04=$$PHA03()
Q PRE04
;
PRE05() ;ASAP 3.0 : Prescriber DEA Number Suffix
; ASAP 4.0+: Prescriber Last Name
N PRE05
I PSOASVER="3.0" D Q PRE05
. S PRE05=$$PRVDEA() I PRE05'="" S PRE05=$P(PRE05,"-",2,99) Q
. S PRE05=$P($$DEA^XUSER(0,PREIEN),"-",2,99)
. I $$PRE04()=$$PHA03() S PRE05=$P($$DEA^XUSER(1,PREIEN),"-",1)
;
Q $P($$GET1^DIQ(200,PREIEN,.01),",",1)
;
PRE06() ;ASAP 3.0 : Prescriber State Lince Number (Not Used)
; ASAP 4.0+: Prescriber First Name
I PSOASVER="3.0" Q ""
Q $P($P($$GET1^DIQ(200,PREIEN,.01),",",2)," ",1)
;
PRE07() ;ASAP 3.0 : Prescriber Alternate ID (Not Used)
; ASAP 4.0+: Prescriber Middle Name
I PSOASVER="3.0" Q ""
Q $P($P($$GET1^DIQ(200,PREIEN,.01),",",2)," ",2)
;
PRE08() ;ASAP 3.0 : Prescriber's Last Name
; ASAP 4.0 & 4.1: N/A (up to PRE07 only)
; ASAP 4.2: Prescriber's Phone Number
I PSOASVER="3.0" Q $P($$GET1^DIQ(200,PREIEN,.01),",",1)
I PSOASVER="4.0"!(PSOASVER="4.1") Q ""
N PRE08
;Work Phone #
S PRE08=$$PHONE($$GET1^DIQ(200,PREIEN,.132)) I PRE08 Q PRE08
;Institution Phone #
N DIV,DIVS,CONTACT,CONTACTS,INSPHONE
I $$DIV4^XUSER(.DIVS,PREIEN) D
. S DIV=0 F S DIV=$O(DIVS(DIV)) Q:'DIV D I PRE08 Q
. . K CONTACTS D GETS^DIQ(4,DIV_",","4*","","CONTACTS") I '$D(CONTACTS) Q
. . S CONTACT="" F S CONTACT=$O(CONTACTS(4.03,CONTACT)) Q:(CONTACT="") D I $G(INSPHONE) Q
. . . I $$PHONE(CONTACTS(4.03,CONTACT,.03))'="" D
. . . . S INSPHONE=$$PHONE(CONTACTS(4.03,CONTACT,.03))
. . ; Default Prescriber Division
. . I +DIVS(DIV),$G(INSPHONE) S PRE08=INSPHONE Q
. . I '$O(DIVS(DIV)),'PRE08,$G(INSPHONE) S PRE08=INSPHONE
I PRE08 Q PRE08
;Last resort: Pharmacy Phone #
Q $$PHA10()
;
PRE09() ;ASAP 3.0: Prescriber' First Name
; ASAP 4.2: Prescriber's DETOX Number if DETOX drug
N DTXCHK,PRDEA S (DTXCHK,PRDEA)=""
I PSOASVER="3.0" Q $P($P($$GET1^DIQ(200,PREIEN,.01),",",2)," ",1)
I PSOASVER="4.2" D
. S DRUGIEN=$$GET1^DIQ(52,RXIEN,6,"I")
. S DTXCHK=$$DETOX^PSSOPKI(DRUGIEN)
. I DTXCHK S PRDEA=$$PRVDETOX^PSOUTIL(PREIEN)
Q PRDEA
;
PRE10() ;ASAP 3.0: Prescriber' Middle Name
I PSOASVER'="3.0" Q ""
Q $P($P($$GET1^DIQ(200,PREIEN,.01),",",2)," ",2)
;
; *** RPH Pharmacist Information (ASAP 3.0 Only) **
RPH03() ;National Provider Identification (NPI)
N RPH03
S RPH03=+$$NPI^XUSNPI("Individual_ID",RPHIEN,DT)
Q $S(RPH03>0:RPH03,1:"")
;
RPH06() ;Pharmacist Last Name
Q $P($$GET1^DIQ(200,RPHIEN,.01),",",1)
;
RPH07() ;Pharmacist First Name
Q $P($P($$GET1^DIQ(200,RPHIEN,.01),",",2)," ",1)
;
RPH08() ;Pharmacist Middle Name
Q $P($P($$GET1^DIQ(200,RPHIEN,.01),",",2)," ",2)
;
TT01() ;Transaction Control Number
; ASAP 3.0 : Same as TH03
; ASAP 4.0+: Same as TH02
I PSOASVER="3.0" Q $$TH03()
Q $$TH02()
;
PHONE(NUMBER) ;Returns the Phone number (numeric only - max 10 digits)
N PHONE
S PHONE=$$NUMERIC(NUMBER)
I $E(PHONE,1)="1" S $E(PHONE,1)=""
Q $S($L(PHONE)=10:PHONE,1:"")
;
ADDRESS(VALUE,LINE) ;Returns Address Line1 and Line2 (max 30 characters)
N ADDRESS,I,DIWL,DIWR,X
K ^UTILITY($J,"W") S X=$$TRIM^XLFSTR(VALUE),DIWL=1,DIWR=30 D ^DIWP
S ADDRESS=$$TRIM^XLFSTR($G(^UTILITY($J,"W",1,LINE,0)))
K ^UTILITY($J,"W")
Q ADDRESS
;
PRVDEA() ;Returns the Provider DEA #
Q $$RXDEA^PSOUTIL(RXIEN)
;
NUMERIC(VALUE) ;Returns the Numeric Value
N NUMERIC,I
S NUMERIC=""
F I=1:1:$L(VALUE) I $E(VALUE,I)?1N S NUMERIC=NUMERIC_$E(VALUE,I)
Q NUMERIC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOASAP0 19368 printed Apr 09, 2024@21:32:37 Page 2
PSOASAP0 ;BIRM/MFR - American Society for Automation in Pharmacy (ASAP) Segments & Fields ;09/07/12
+1 ;;7.0;OUTPATIENT PHARMACY;**408,451,496,504,625,630,659,705**;DEC 1997;Build 5
+2 ;External reference to $$NATURE^ORUTL3 supported by DBIA 5890
+3 ;External reference to ^ORDEA is supported by DBIA 5709
+4 ;External reference to PATIENT file (#2) supported by DBIA 5597
+5 ;External reference to $$NPI^XUSNPI supported by DBIA 4532
+6 ;External reference to $$DIV4^XUSER supported by DBIA 2533
+7 ;
+8 ; ******************** ASAP 1995 Version ********************
ASAP95(RXIEN,FILL) ;Returns the entire ASAP 1995 record for the Rx/Fill
+1 ;Input: (r) RXIEN - Rx IEN (#52)
+2 ; (r) FILL - Fill #
+3 NEW ASAP95,RXNUM
+4 SET RXNUM=$EXTRACT(RXIEN+10000000,$LENGTH(RXIEN+10000000)-6,$LENGTH(RXIEN+10000000))
+5 ;Transmission Type Identifier
SET $EXTRACT(ASAP95,1,3)="ASB"
+6 ;Bank Identification Number
SET $EXTRACT(ASAP95,4,9)="VA"_$EXTRACT(10000+$$SITE^VASITE(),2,5)
+7 ;ASAP Version (A2 = 1995)
SET $EXTRACT(ASAP95,10,11)="A2"
+8 ;Transaction Code ("01" - Controlled Substance)
SET $EXTRACT(ASAP95,12,13)="01"
+9 ;Pharmacy DEA# Number
SET $EXTRACT(ASAP95,14,25)=$EXTRACT($$PHA03^PSOASAP(),1,12)
+10 ;Patient ID (SSN)
SET $EXTRACT(ASAP95,26,45)=$$PAT03^PSOASAP()
+11 ;Patient's Zip Code (first 3 digits)
SET $EXTRACT(ASAP95,46,48)=$EXTRACT($$PAT16^PSOASAP(),1,3)
+12 ;Patient's DOB (Format: YYYYMMDD)
SET $EXTRACT(ASAP95,49,56)=$$PAT18^PSOASAP()
+13 ;Patient's Gender
SET $EXTRACT(ASAP95,57,57)=$SELECT($$PAT19^PSOASAP()="M":1,1:"2")
+14 ;Date Filled (Release/RTS Date) (Format: YYYYMMDD)
SET $EXTRACT(ASAP95,58,65)=$$DSP05^PSOASAP()
+15 ;Prescription Number (IEN - Because it must be 7-digit numeric )
SET $EXTRACT(ASAP95,66,72)=RXNUM
+16 ;Fill Number
SET $EXTRACT(ASAP95,73,74)=$EXTRACT(FILL+100,2,3)
+17 ;Quantity
SET $EXTRACT(ASAP95,75,79)=$EXTRACT(100000+$$DSP09^PSOASAP(),2,6)
+18 ;Days Supply
SET $EXTRACT(ASAP95,80,82)=$EXTRACT(1000+$$DSP10^PSOASAP(),2,4)
+19 ;Compound Flag (1=Not compound)
SET $EXTRACT(ASAP95,83,83)="1"
+20 ;NDC (Fomart: 99999999999)
SET $EXTRACT(ASAP95,84,94)=$EXTRACT($$DSP08^PSOASAP(),1,11)
+21 ;Prescriber's DEA #
SET $EXTRACT(ASAP95,95,104)=$EXTRACT($$PRE02^PSOASAP(),1,10)
+22 ;DEA Suffix
SET $EXTRACT(ASAP95,105,108)=""
+23 ;Date Written (Format: YYYYMMDD)
SET $EXTRACT(ASAP95,109,116)=$$DSP03^PSOASAP()
+24 ;Refills Authorized
SET $EXTRACT(ASAP95,117,118)=$EXTRACT(100+$$DSP04^PSOASAP(),2,3)
+25 ;Rx Origin Code (0:Not Specified/1:Written/2:Telephone)
SET $EXTRACT(ASAP95,119,119)=$SELECT(+$$DSP12^PSOASAP()>2:0,1:+$$DSP12^PSOASAP())
+26 ;Customer Location (Always: "03" - Outpatient)
SET $EXTRACT(ASAP95,120,121)="03"
+27 ;DEA Suffix
SET $EXTRACT(ASAP95,122,128)=""
+28 ;Alternate Prescriber # (VA #)
SET $EXTRACT(ASAP95,129,138)=$EXTRACT($$PRE03^PSOASAP(),1,10)
+29 ;Patient's Last Name
SET $EXTRACT(ASAP95,139,153)=$EXTRACT($$PAT07^PSOASAP(),1,15)
+30 ;Patient's First Name
SET $EXTRACT(ASAP95,154,168)=$EXTRACT($$PAT08^PSOASAP(),1,15)
+31 ;Patient's Address
SET $EXTRACT(ASAP95,169,198)=$EXTRACT($$PAT12^PSOASAP(),1,30)
+32 ;Patient's State
SET $EXTRACT(ASAP95,199,200)=$EXTRACT($$PAT15^PSOASAP(),1,2)
+33 ;Patient's Zip Code
SET $EXTRACT(ASAP95,201,209)=$EXTRACT($$PAT16^PSOASAP(),1,9)
+34 ;Filler
SET $EXTRACT(ASAP95,210,222)=""
+35 QUIT ASAP95
+36 ;
+37 ; ******************** ASAP 3.0 and above versions ********************
+38 ; *** TH Segment ***
TH02() ;ASAP 3.0 : Business Partner Implemetation Version (Not Used)
+1 ; ASAP 4.0+: Transaction Control Number
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT +$$SITE^VASITE()_"-"_+$GET(BATCHIEN)
+4 ;
TH03() ;ASAP 3.0 : Transaction Control Number
+1 ; ASAP 4.0+: Transaction Type (Always "01" - Send/Request Transaction)
+2 IF PSOASVER="3.0"
QUIT +$$SITE^VASITE()_"-"_+$GET(BATCHIEN)
+3 QUIT "01"
+4 ;
TH05() ;ASAP 3.0 : Message Type (Not Used)
+1 ; ASAP 4.0+: Creation Date (Format: YYYYMMDD)
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT $$FMTHL7^XLFDT($$HTFM^XLFDT($HOROLOG)\1)
+4 ;
TH06() ;ASAP 3.0 : Response ID (Not Used)
+1 ; ASAP 4.0+: Creation Time. Format: HHMMSS or HHMM
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT $EXTRACT($PIECE($$HTFM^XLFDT($HOROLOG),".",2)_"000000",1,6)
+4 ;
TH07() ;ASAP 3.0 : Project ID (Not Used)
+1 ; ASAP 4.0+: File Type. Returns: "T" - Test or "P" - Production
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT $SELECT($$PROD^XUPROD(1):"P",1:"T")
+4 ;
TH08() ;ASAP 3.0: Creation Date (Format: YYYYMMDD)
+1 ; ASAP 4.0: Composite Element Separator (:)
+2 ; ASAP 4.1+: Routing Number (Real-time transactions only) - Not Used
+3 IF PSOASVER="4.0"
QUIT ":"
+4 IF PSOASVER'="3.0"
QUIT ""
+5 QUIT $$FMTHL7^XLFDT($$HTFM^XLFDT($HOROLOG)\1)
+6 ;
TH09() ;ASAP 3.0 : Creation Time. Format: HHMMSS or HHMM
+1 ; ASAP 4.1+: Segment Terminator Character
+2 IF PSOASVER="3.0"
QUIT $EXTRACT($PIECE($$HTFM^XLFDT($HOROLOG),".",2)_"000000",1,6)
+3 QUIT $PIECE($$VERDATA^PSOSPMU0(PSOASVER,"B"),"^",3)
+4 ;
TH10() ;ASAP 3.0 : File Type
+1 ; ASAP 4.0+: N/A
+2 IF PSOASVER="3.0"
QUIT $SELECT($$PROD^XUPROD(1):"P",1:"T")
+3 QUIT ""
+4 ;
TH12() ;ASAP 3.0 : Composite Element Separator
+1 ; ASAP 4.0+: N/A
+2 IF PSOASVER="3.0"
QUIT ":"
+3 QUIT ""
+4 ;
TH13() ;ASAP 3.0 : Data Segment Terminator Character
+1 ; ASAP 4.0+: N/A
+2 IF PSOASVER'="3.0"
QUIT ""
+3 QUIT $PIECE($$VERDATA^PSOSPMU0(PSOASVER,"B"),"^",3)
+4 ;
+5 ; *** PHA Segment ***
PHA01() ;National Provider Identifier
+1 NEW NPINST,NPINUM
+2 SET NPINST=$$GET1^DIQ(59,SITEIEN,101,"I")
IF 'NPINST
QUIT ""
+3 SET NPINUM=+$$NPI^XUSNPI("Organization_ID",NPINST,DT)
+4 QUIT $SELECT(NPINUM>0:NPINUM,1:"")
+5 ;
PHA03() ;Pharmacy DEA Number
+1 NEW PHA03,INST
+2 ;Primary source: Pharmacy NPI Institution
+3 SET PHA03=""
SET INST=$$GET1^DIQ(59,SITEIEN,101,"I")
+4 IF INST
SET PHA03=$$WHAT^XUAF4(INST,52)
+5 ;Backup source: Pharmacy Related Institution
+6 IF PHA03=""
Begin DoDot:1
+7 SET INST=$$GET1^DIQ(59,SITEIEN,100,"I")
+8 IF INST
SET PHA03=$$WHAT^XUAF4(INST,52)
End DoDot:1
+9 QUIT PHA03
+10 ;
PHA10() ;Phone Number
+1 QUIT $$PHONE($$GET1^DIQ(59,SITEIEN,.03)_$$GET1^DIQ(59,SITEIEN,.04))
+2 ;
+3 ; *** PAT Segment ***
PAT03() ;ASAP 3.0 : Unique System ID - Patient (Not Used)
+1 ; ASAP 4.0+: ID of Patient (SSN)
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT $PIECE($GET(VADM(2)),"^",1)
+4 ;
PAT04() ;ASAP 3.0 : SSN
+1 ; ASAP 4.0+: ID Qualifier of Additional Patient Identifier (Not Used)
+2 IF PSOASVER="3.0"
QUIT $PIECE($GET(VADM(2)),"^",1)
+3 QUIT ""
+4 ;
PAT12() ;Patient Address Information - Line 1
+1 ; ASAP 4.2: Length = 35 characters (All others: 30 characters)
+2 NEW ADDRESS
+3 IF PSOASVER="4.2"
Begin DoDot:1
+4 SET ADDRESS=$SELECT($GET(VAPA(1))'="":VAPA(1),$GET(VAPA(11)):"STREET ADDRESS UNKNOWN",1:"")
End DoDot:1
QUIT ADDRESS
+5 SET ADDRESS=$$TRIM^XLFSTR($GET(VAPA(1)))_$SELECT($$TRIM^XLFSTR($GET(VAPA(2)))'="":" "_VAPA(2),1:"")_$SELECT($$TRIM^XLFSTR($GET(VAPA(3)))'="":" "_VAPA(3),1:"")
+6 IF ADDRESS=""
IF $GET(VAPA(11))
SET ADDRESS="STREET ADDRESS UNKNOWN"
+7 IF $EXTRACT(ADDRESS,1,30)'[" "
QUIT $EXTRACT(ADDRESS,1,30)
+8 QUIT $$ADDRESS(ADDRESS,1)
+9 ;
PAT13() ;Patient Address Information - Line 2
+1 ; ASAP 4.2: Length = 35 characters (All others: 30 characters)
+2 IF PSOASVER="4.2"
QUIT $GET(VAPA(2))
+3 NEW ADDRESS
+4 SET ADDRESS=$$TRIM^XLFSTR($GET(VAPA(1)))_$SELECT($$TRIM^XLFSTR($GET(VAPA(2)))'="":" "_VAPA(2),1:"")_$SELECT($$TRIM^XLFSTR($GET(VAPA(3)))'="":" "_VAPA(3),1:"")
+5 IF $EXTRACT(ADDRESS,1,30)'[" "
QUIT $EXTRACT(ADDRESS,31,999)
+6 QUIT $$ADDRESS(ADDRESS,2)
+7 ;
PAT15() ;Patient State Address
+1 ; US State Abbreviation
+2 IF $$PAT22()=""
QUIT $$GET1^DIQ(5,+$GET(VAPA(5)),1)
+3 ; International State/Province
+4 QUIT $PIECE($GET(VAPA(23)),"^")
+5 ;
PAT16() ;Patient ZIP Code
+1 ; US Zip Code
+2 IF $$PAT22()=""
QUIT $TRANSLATE($PIECE($GET(VAPA(11)),"^",1),"-")
+3 ; International Postal Code
+4 QUIT $PIECE($GET(VAPA(24)),"^")
+5 ;
PAT17() ;Patient Phone Number
+1 NEW PAT17
+2 ;PHONE NUMBER [RESIDENCE] (Home)
+3 SET PAT17=$$PHONE($PIECE($GET(VAPA(8)),"^",1))
IF PAT17
QUIT PAT17
+4 ;PHONE NUMBER [CELLULAR] (Cell)
+5 SET PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.134))
IF PAT17
QUIT PAT17
+6 ;PHONE NUMBER [WORK] (Work)
+7 SET PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.132))
IF PAT17
QUIT PAT17
+8 ;K-WORK PHONE NUMBER (Next Of Kin)
+9 SET PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.21011))
IF PAT17
QUIT PAT17
+10 ;K2-WORK PHONE NUMBER (Secondary Next Of Kin)
+11 SET PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.211011))
IF PAT17
QUIT PAT17
+12 ;E-WORK PHONE NUMBER (Work Emergency)
+13 SET PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.33011))
IF PAT17
QUIT PAT17
+14 ;E2-WORK PHONE NUMBER (Secondary Work Emergency)
+15 SET PAT17=$$PHONE($$GET1^DIQ(2,PATIEN,.331011))
IF PAT17
QUIT PAT17
+16 ;Last resort: Pharmacy Phone #
+17 QUIT $$PHA10()
+18 ;
PAT18() ;ASAP 3.0 : Email Address (Not Used)
+1 ; ASAP 4.0+: Patient DOB
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT $$FMTHL7^XLFDT($PIECE($GET(VADM(3)),"^",1))
+4 ;
PAT19() ;ASAP 3.0 : Patient DOB
+1 ; ASAP 4.0+: Patient Gender Code
+2 IF PSOASVER="3.0"
QUIT $$FMTHL7^XLFDT($PIECE($GET(VADM(3)),"^",1))
+3 QUIT $SELECT($PIECE($GET(VADM(5)),"^",1)'="":$PIECE($GET(VADM(5)),"^",1),1:"U")
+4 ;
PAT20() ;ASAP 3.0 : Patient Gender Code
+1 ; ASAP 4.0+: Species Code (Always return "01" for 'Human')
+2 IF PSOASVER="3.0"
QUIT $SELECT($PIECE($GET(VADM(5)),"^",1)'="":$PIECE($GET(VADM(5)),"^",1),1:"U")
+3 QUIT "01"
+4 ;
PAT22() ;ASAP 3.0 : Primary Prescription Coverage Type (Not Used)
+1 ; ASAP 4.0+:Country of Non-U.S. Resident
+2 IF PSOASVER="3.0"
QUIT ""
+3 NEW CNTRYIEN,FIPSCODE
+4 SET CNTRYIEN=+$GET(VAPA(25))
IF 'CNTRYIEN
QUIT ""
+5 SET FIPSCODE=$$GET1^DIQ(779.004,CNTRYIEN,1.2)
+6 QUIT $SELECT(FIPSCODE="US":"",FIPSCODE="CA":"CN",1:FIPSCODE)
+7 ;
+8 ; *** RX Segment (ASAP 3.0 only) ***
RX08() ;Date Rx Written (Format: YYYYMMDD)
+1 NEW RX08
+2 SET RX08=$$GET1^DIQ(52,+$GET(RXIEN),1,"I")
+3 ; Date Rx Written (ISSUE DATE) cannot be in the future or after Rx Fill Date (Use LOGIN DATE instead)
+4 IF RX08>DT!(RX08>$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM))
Begin DoDot:1
+5 SET RX08=$$GET1^DIQ(52,+$GET(RXIEN),21,"I")\1
End DoDot:1
+6 QUIT $$FMTHL7^XLFDT(RX08)
+7 ;
RX14() ;Product ID (NDC - National Drug Code)
+1 NEW RX14
SET RX14=""
+2 IF RECTYPE="V"
IF $GET(RTSDATA("NDC"))'=""
SET RX14=$$NUMERIC(RTSDATA("NDC"))
+3 IF 'RX14
SET RX14=$$NUMERIC($$GET1^DIQ(50,DRUGIEN,31))
+4 IF 'RX14
SET RX14=$$NUMERIC($$GETNDC^PSONDCUT(RXIEN,+FILLNUM))
+5 QUIT RX14
+6 ;
+7 ; *** DSP Segment ***
DSP01() ;ASAP 3.0 : Reporting Status ("01" - Add / "02" - Change / "03" - Delete)
+1 ; ASAP 4.0 : Reporting Status ("" - New / "01" - Revise / "02" - Void)
+2 ; ASAP 4.1+: Reporting Status ("00" - New / "01" - Revise / "02" - Void)
+3 IF PSOASVER="3.0"
QUIT $SELECT($GET(RECTYPE)="N":"01",$GET(RECTYPE)="R":"02",$GET(RECTYPE)="V":"03",1:"")
+4 IF PSOASVER="4.0"
IF RECTYPE="N"
QUIT ""
+5 QUIT $SELECT($GET(RECTYPE)="N":"00",$GET(RECTYPE)="R":"01",$GET(RECTYPE)="V":"02",1:"")
+6 ;
DSP02() ;ASAP 3.0 : Program Participation Status (Not Used)
+1 ; ASAP 4.0+: Prescription Number
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT $$GET1^DIQ(52,+$GET(RXIEN),.01)
+4 ;
DSP03() ;ASAP 3.0 : Prescription Number
+1 ; ASAP 4.0+: Date Rx Written (Format: YYYYMMDD)
+2 IF PSOASVER="3.0"
QUIT $$GET1^DIQ(52,+$GET(RXIEN),.01)
+3 NEW DSP03
+4 SET DSP03=$$GET1^DIQ(52,+$GET(RXIEN),1,"I")
+5 ; Date Rx Written (ISSUE DATE) cannot be in the future or after Rx Fill Date (Use LOGIN DATE instead)
+6 IF DSP03>DT!(DSP03>$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM))
Begin DoDot:1
+7 SET DSP03=$$GET1^DIQ(52,+$GET(RXIEN),21,"I")\1
End DoDot:1
+8 QUIT $$FMTHL7^XLFDT(DSP03)
+9 ;
DSP04() ;ASAP 3.0 : Refill Number
+1 ; ASAP 4.0+: Refills Authorized
+2 IF PSOASVER="3.0"
QUIT +FILLNUM
+3 QUIT +$$GET1^DIQ(52,+$GET(RXIEN),9)
+4 ;
DSP05() ;ASAP 3.0 : Unique System ID - RPh (Not Used)
+1 ; ASAP 4.0+: Date Filled (Release Date) (Format: YYYYMMDD)
+2 ; ZERO RPT 4.0+: Date Report was created
+3 IF PSOASVER="3.0"
QUIT ""
+4 NEW DSP05
+5 IF $GET(BATCHIEN)
IF $$GET1^DIQ(58.42,BATCHIEN,2,"I")="ZR"
SET DSP05=$$GET1^DIQ(58.42,BATCHIEN,8,"I")
QUIT $$FMTHL7^XLFDT((DSP05)\1)
+6 SET DSP05=$SELECT((RECTYPE="V")&($GET(RTSDATA("RELDTTM"))'=""):$GET(RTSDATA("RELDTTM")),$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM):$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM),1:DT)\1
+7 QUIT $SELECT(DSP05:$$FMTHL7^XLFDT(DSP05),1:"")
+8 ;
DSP06() ;ASAP 3.0 : Unique System ID - Patient (Not Used)
+1 ; ASAP 4.0+: Refill Number (Partials are always "0")
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT +FILLNUM
+4 ;
DSP07() ;ASAP 3.0 : Unique System ID - Prescriber (Not Used)
+1 ; ASAP 4.0+: Product ID Qualifier (Always return "01" for 'NDC')
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT "01"
+4 ;
DSP08() ;ASAP 3.0 : Unique System ID - Drug (Not Used)
+1 ; ASAP 4.0+:Product ID (NDC - National Drug Code)
+2 IF PSOASVER="3.0"
QUIT ""
+3 NEW DSP08
SET DSP08=""
+4 IF RECTYPE="V"
IF $GET(RTSDATA("NDC"))'=""
SET DSP08=$$NUMERIC(RTSDATA("NDC"))
+5 IF 'DSP08
SET DSP08=$$NUMERIC($$GET1^DIQ(50,DRUGIEN,31))
+6 IF 'DSP08
SET DSP08=$$NUMERIC($$GETNDC^PSONDCUT(RXIEN,+FILLNUM))
+7 QUIT DSP08
+8 ;
DSP09() ;ASAP 3.0 : Date Filled
+1 ; ASAP 4.0+: Quantity Dispensed
+2 NEW DSP09
+3 IF PSOASVER="3.0"
Begin DoDot:1
+4 SET DSP09=$SELECT(RECTYPE="V":$GET(RTSDATA("RELDTTM")),$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM):$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM),1:DT)\1
+5 SET DSP09=$SELECT(DSP09'="":$$FMTHL7^XLFDT(DSP09),1:"")
End DoDot:1
QUIT DSP09
+6 QUIT $SELECT((RECTYPE="V")&($GET(RTSDATA("QTY"))'=""):$GET(RTSDATA("QTY")),1:$$RXQTY^PSOBPSUT(RXIEN,FILLNUM))
+7 ;
DSP10() ;ASAP 3.0 : Time Filled (Not Used)
+1 ; ASAP 4.0+: Days Supply
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT $SELECT((RECTYPE="V")&($GET(RTSDATA("DAYSUP"))'=""):$GET(RTSDATA("DAYSUP")),1:$$RXDAYSUP^PSOBPSUT(RXIEN,FILLNUM))
+4 ;
DSP11() ;ASAP 3.0 : Product ID Qualifier (01:NDC)
+1 ; ASAP 4.0+: Drug Dosage Units Code
+2 IF PSOASVER="3.0"
QUIT "01"
+3 NEW UNIT
+4 SET UNIT=$$GET1^DIQ(50,DRUGIEN,82,"I")
+5 QUIT $SELECT(UNIT="EA":"01",UNIT="ML":"02",UNIT="GM":"03",1:"")
+6 ;
DSP12() ;ASAP 3.0 : Product ID (NDC)
+1 ; ASAP 4.0+: Transmission Form of Rx Origin Code (Nature of Order)
+2 NEW DSP12
SET DSP12=""
+3 IF PSOASVER="3.0"
Begin DoDot:1
+4 IF RECTYPE="V"
IF $GET(RTSDATA("NDC"))'=""
SET DSP12=$$NUMERIC(RTSDATA("NDC"))
+5 IF 'DSP12
SET DSP12=$$NUMERIC($$GET1^DIQ(50,DRUGIEN,31))
+6 IF 'DSP12
SET DSP12=$$NUMERIC($$GETNDC^PSONDCUT(RXIEN,+FILLNUM))
End DoDot:1
QUIT DSP12
+7 NEW NOO,ORDNUM
SET NOO="W"
+8 SET ORDNUM=$$GET1^DIQ(52,RXIEN,39.3,"I")
+9 IF $GET(ORDNUM)
Begin DoDot:1
+10 SET NOO=$PIECE($$NATURE^ORUTL3(ORDNUM),"^",2)
End DoDot:1
+11 QUIT $SELECT(NOO="W":"01",(NOO="V")!(NOO="P"):"02",NOO="E":"05",1:"99")
+12 ;
DSP13() ;ASAP 3.0 : Product Description (Not Used)
+1 ; ASAP 4.0+: Partial Fill Indicator
+2 IF PSOASVER="3.0"
QUIT ""
+3 IF PSOASVER="4.0"!(PSOASVER="4.1")
QUIT $SELECT(FILLNUM["P":"01",1:"02")
+4 QUIT $SELECT(FILLNUM["P":$EXTRACT(100+$EXTRACT(FILLNUM,2,3),2,3),1:"00")
+5 ;
DSP14() ;ASAP 3.0 : Quantity Dispensed
+1 ; ASAP 4.0+: Pharmacist National Provider Identifier (NPI)
+2 IF PSOASVER="3.0"
QUIT $SELECT(RECTYPE="V":$GET(RTSDATA("QTY")),1:$$RXQTY^PSOBPSUT(RXIEN,FILLNUM))
+3 NEW NPI
+4 SET NPI=+$$NPI^XUSNPI("Individual_ID",RPHIEN,DT)
+5 QUIT $SELECT(NPI>0:NPI,1:"")
+6 ;
DSP15() ;ASAP 3.0 : Days Supply
+1 ; ASAP 4.0+: Pharmacist State License Number (Not Used)
+2 IF PSOASVER="3.0"
QUIT $SELECT(RECTYPE="V":$GET(RTSDATA("DAYSUP")),1:$$RXDAYSUP^PSOBPSUT(RXIEN,FILLNUM))
+3 QUIT ""
+4 ;
DSP16() ;ASAP 3.0 : Basis of Days Supply Determiniation (Always "3" for 'As directed by doctor')
+1 ; ASAP 4.0+: Classification Code for Payment Type (Always return "05" for 'Military Installations and VA')
+2 IF PSOASVER="3.0"
QUIT "3"
+3 QUIT "05"
+4 ;
DSP17() ;ASAP 3.0 : Refills Remaining (Not Used)
+1 ; ASAP 4.0 : N/A
+2 ; ASAP 4.1+: Date Sold
+3 IF PSOASVER="3.0"!(PSOASVER="4.0")
QUIT ""
+4 QUIT $$DSP05()
+5 ;
+6 ; *** PRE Segment ***
PRE01() ;ASAP 3.0 : Not Used
+1 ; ASAP 4.0+: Prescriber National Provider Identifier (NPI)
+2 IF PSOASVER="3.0"
QUIT ""
+3 NEW PRE01
+4 SET PRE01=+$$NPI^XUSNPI("Individual_ID",PREIEN)
+5 QUIT $SELECT(PRE01>0:PRE01,1:"")
+6 ;
PRE02() ;Prescriber DEA Number
+1 ;P705 RX Issue/Written Date
NEW PRE02,RXISSDT
+2 SET RXISSDT=$$GET1^DIQ(52,+$GET(RXIEN),1,"I")
+3 SET PRE02=$$PRVDEA()
IF PRE02'=""
QUIT $PIECE(PRE02,"-",1)
+4 SET PRE02=$PIECE($$DEA^XUSER(0,PREIEN,RXISSDT),"-",1)
+5 IF (PRE02="")!($PIECE($$DEA^XUSER(0,PREIEN,RXISSDT),"-",2,99)'="")
SET PRE02=$$PHA03()
+6 QUIT PRE02
+7 ;
PRE03() ;ASAP 3.0 : Prescriber NPI
+1 ; ASAP 4.0+: Prescriber DEA Number Suffix
+2 NEW PRE03
+3 IF PSOASVER="3.0"
Begin DoDot:1
+4 SET PRE03=+$$NPI^XUSNPI("Individual_ID",PREIEN)
+5 SET PRE03=$SELECT(PRE03>0:PRE03,1:"")
End DoDot:1
QUIT PRE03
+6 ;
+7 SET PRE03=$$PRVDEA()
IF PRE03'=""
QUIT $PIECE(PRE03,"-",2,99)
+8 SET PRE03=$PIECE($$DEA^XUSER(0,PREIEN),"-",2,99)
+9 IF $$PRE02()=$$PHA03()
SET PRE03=$PIECE($$DEA^XUSER(1,PREIEN),"-",1)
+10 QUIT PRE03
+11 ;
PRE04() ;ASAP 3.0 : Prescriber DEA Number
+1 ; ASAP 4.0+: Prescriber State License Number (Not Used)
+2 IF PSOASVER'="3.0"
QUIT ""
+3 ;
+4 NEW PRE04
+5 SET PRE04=$$PRVDEA()
IF PRE04'=""
QUIT $PIECE(PRE04,"-",1)
+6 SET PRE04=$PIECE($$DEA^XUSER(0,PREIEN),"-",1)
+7 IF (PRE04="")!($PIECE($$DEA^XUSER(0,PREIEN),"-",2,99)'="")
SET PRE04=$$PHA03()
+8 QUIT PRE04
+9 ;
PRE05() ;ASAP 3.0 : Prescriber DEA Number Suffix
+1 ; ASAP 4.0+: Prescriber Last Name
+2 NEW PRE05
+3 IF PSOASVER="3.0"
Begin DoDot:1
+4 SET PRE05=$$PRVDEA()
IF PRE05'=""
SET PRE05=$PIECE(PRE05,"-",2,99)
QUIT
+5 SET PRE05=$PIECE($$DEA^XUSER(0,PREIEN),"-",2,99)
+6 IF $$PRE04()=$$PHA03()
SET PRE05=$PIECE($$DEA^XUSER(1,PREIEN),"-",1)
End DoDot:1
QUIT PRE05
+7 ;
+8 QUIT $PIECE($$GET1^DIQ(200,PREIEN,.01),",",1)
+9 ;
PRE06() ;ASAP 3.0 : Prescriber State Lince Number (Not Used)
+1 ; ASAP 4.0+: Prescriber First Name
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT $PIECE($PIECE($$GET1^DIQ(200,PREIEN,.01),",",2)," ",1)
+4 ;
PRE07() ;ASAP 3.0 : Prescriber Alternate ID (Not Used)
+1 ; ASAP 4.0+: Prescriber Middle Name
+2 IF PSOASVER="3.0"
QUIT ""
+3 QUIT $PIECE($PIECE($$GET1^DIQ(200,PREIEN,.01),",",2)," ",2)
+4 ;
PRE08() ;ASAP 3.0 : Prescriber's Last Name
+1 ; ASAP 4.0 & 4.1: N/A (up to PRE07 only)
+2 ; ASAP 4.2: Prescriber's Phone Number
+3 IF PSOASVER="3.0"
QUIT $PIECE($$GET1^DIQ(200,PREIEN,.01),",",1)
+4 IF PSOASVER="4.0"!(PSOASVER="4.1")
QUIT ""
+5 NEW PRE08
+6 ;Work Phone #
+7 SET PRE08=$$PHONE($$GET1^DIQ(200,PREIEN,.132))
IF PRE08
QUIT PRE08
+8 ;Institution Phone #
+9 NEW DIV,DIVS,CONTACT,CONTACTS,INSPHONE
+10 IF $$DIV4^XUSER(.DIVS,PREIEN)
Begin DoDot:1
+11 SET DIV=0
FOR
SET DIV=$ORDER(DIVS(DIV))
if 'DIV
QUIT
Begin DoDot:2
+12 KILL CONTACTS
DO GETS^DIQ(4,DIV_",","4*","","CONTACTS")
IF '$DATA(CONTACTS)
QUIT
+13 SET CONTACT=""
FOR
SET CONTACT=$ORDER(CONTACTS(4.03,CONTACT))
if (CONTACT="")
QUIT
Begin DoDot:3
+14 IF $$PHONE(CONTACTS(4.03,CONTACT,.03))'=""
Begin DoDot:4
+15 SET INSPHONE=$$PHONE(CONTACTS(4.03,CONTACT,.03))
End DoDot:4
End DoDot:3
IF $GET(INSPHONE)
QUIT
+16 ; Default Prescriber Division
+17 IF +DIVS(DIV)
IF $GET(INSPHONE)
SET PRE08=INSPHONE
QUIT
+18 IF '$ORDER(DIVS(DIV))
IF 'PRE08
IF $GET(INSPHONE)
SET PRE08=INSPHONE
End DoDot:2
IF PRE08
QUIT
End DoDot:1
+19 IF PRE08
QUIT PRE08
+20 ;Last resort: Pharmacy Phone #
+21 QUIT $$PHA10()
+22 ;
PRE09() ;ASAP 3.0: Prescriber' First Name
+1 ; ASAP 4.2: Prescriber's DETOX Number if DETOX drug
+2 NEW DTXCHK,PRDEA
SET (DTXCHK,PRDEA)=""
+3 IF PSOASVER="3.0"
QUIT $PIECE($PIECE($$GET1^DIQ(200,PREIEN,.01),",",2)," ",1)
+4 IF PSOASVER="4.2"
Begin DoDot:1
+5 SET DRUGIEN=$$GET1^DIQ(52,RXIEN,6,"I")
+6 SET DTXCHK=$$DETOX^PSSOPKI(DRUGIEN)
+7 IF DTXCHK
SET PRDEA=$$PRVDETOX^PSOUTIL(PREIEN)
End DoDot:1
+8 QUIT PRDEA
+9 ;
PRE10() ;ASAP 3.0: Prescriber' Middle Name
+1 IF PSOASVER'="3.0"
QUIT ""
+2 QUIT $PIECE($PIECE($$GET1^DIQ(200,PREIEN,.01),",",2)," ",2)
+3 ;
+4 ; *** RPH Pharmacist Information (ASAP 3.0 Only) **
RPH03() ;National Provider Identification (NPI)
+1 NEW RPH03
+2 SET RPH03=+$$NPI^XUSNPI("Individual_ID",RPHIEN,DT)
+3 QUIT $SELECT(RPH03>0:RPH03,1:"")
+4 ;
RPH06() ;Pharmacist Last Name
+1 QUIT $PIECE($$GET1^DIQ(200,RPHIEN,.01),",",1)
+2 ;
RPH07() ;Pharmacist First Name
+1 QUIT $PIECE($PIECE($$GET1^DIQ(200,RPHIEN,.01),",",2)," ",1)
+2 ;
RPH08() ;Pharmacist Middle Name
+1 QUIT $PIECE($PIECE($$GET1^DIQ(200,RPHIEN,.01),",",2)," ",2)
+2 ;
TT01() ;Transaction Control Number
+1 ; ASAP 3.0 : Same as TH03
+2 ; ASAP 4.0+: Same as TH02
+3 IF PSOASVER="3.0"
QUIT $$TH03()
+4 QUIT $$TH02()
+5 ;
PHONE(NUMBER) ;Returns the Phone number (numeric only - max 10 digits)
+1 NEW PHONE
+2 SET PHONE=$$NUMERIC(NUMBER)
+3 IF $EXTRACT(PHONE,1)="1"
SET $EXTRACT(PHONE,1)=""
+4 QUIT $SELECT($LENGTH(PHONE)=10:PHONE,1:"")
+5 ;
ADDRESS(VALUE,LINE) ;Returns Address Line1 and Line2 (max 30 characters)
+1 NEW ADDRESS,I,DIWL,DIWR,X
+2 KILL ^UTILITY($JOB,"W")
SET X=$$TRIM^XLFSTR(VALUE)
SET DIWL=1
SET DIWR=30
DO ^DIWP
+3 SET ADDRESS=$$TRIM^XLFSTR($GET(^UTILITY($JOB,"W",1,LINE,0)))
+4 KILL ^UTILITY($JOB,"W")
+5 QUIT ADDRESS
+6 ;
PRVDEA() ;Returns the Provider DEA #
+1 QUIT $$RXDEA^PSOUTIL(RXIEN)
+2 ;
NUMERIC(VALUE) ;Returns the Numeric Value
+1 NEW NUMERIC,I
+2 SET NUMERIC=""
+3 FOR I=1:1:$LENGTH(VALUE)
IF $EXTRACT(VALUE,I)?1N
SET NUMERIC=NUMERIC_$EXTRACT(VALUE,I)
+4 QUIT NUMERIC
