Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOASAP0

PSOASAP0.m

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