- 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 Jan 18, 2025@03:25: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