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

PSODEAU1.m

Go to the documentation of this file. 
  1. PSODEAU1 ;ALB/BI - DEA Manual Entry ;05/15/2018
  1.  ;;7.0;OUTPATIENT PHARMACY;**545,731**;DEC 1997;Build 18
  1.  ;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
  1.  ;External reference to XUEPCS DATA file (#8991.6) is supported by DBIA 7015
  1.  ;External reference to XUEPCS PSDRPH AUDIT file (#8991.7) is supported by DBIA 7016
  1.  ;External reference to KEYS sub-file (#200.051) is supported by DBIA 7054
  1.  ;References to Cache methods class.HttpResponse, class.Data, class.AtEnd, class.ReadLine() are supported by SAC exemption 20210601-01
  1.  ;
  1.  Q
  1.  ;
  1. WSGET(FG,DEA) ; Function to Get the Remote DEA information, Return in FG.
  1.  ; INPUT:   DEA      ;Properly formatted DEA Number for lookup.
  1.  ;
  1.  ; OUTPUT:  FG       ;Web Service Response Global
  1.  ;
  1.  ; RETURN:  Status code with a text message.
  1.  ;          If not filled successfully a "0^Error Message" will be returned.
  1.  ;
  1.  Q $$WSGET^PSODEAU0(.FG,DEA)
  1.  ;
  1. FILEFM(RET,DATA,NPIEN)  ; -- File DEA Information in the DEA NUMBERS FILE #8991.9
  1.  ; Invoked by RPC: XU EPCS ADD DEA
  1.  N DNDEAIEN,DNDEATXT,FDA,IENROOT,IENS,MSGROOT,SUFFIX,XSTATE,XIP
  1.  S RET=0
  1.  I '$D(DATA) S RET=0 G FILEFMX
  1.  ;
  1.  S DNDEATXT=$P(DATA,U,11) I DNDEATXT="" G FILEFMX
  1.  S DNDEAIEN=$O(^XTV(8991.9,"B",DNDEATXT,0))
  1.  S IENS=$S($G(DNDEAIEN):$G(DNDEAIEN)_",",1:"+1,")
  1.  ;
  1.  ; INPUT:  DATA - A STRING OF DEA INFORMATION DELIMITED BY THE "^"
  1.  S FDA(1,8991.9,IENS,1.1)=$P(DATA,U,1)         ;  1 - PROVIDER NAME
  1.  S FDA(1,8991.9,IENS,1.2)=$P(DATA,U,2)         ;  2 - ADDRESS 1
  1.  S FDA(1,8991.9,IENS,1.3)=$P(DATA,U,3)         ;  3 - ADDRESS 2
  1.  S FDA(1,8991.9,IENS,1.4)=$P(DATA,U,4)         ;  4 - ADDRESS 3
  1.  S FDA(1,8991.9,IENS,1.5)=$P(DATA,U,5)         ;  5 - CITY
  1.  ;
  1.  ; Special State Processing
  1.  D POSTAL^XIPUTIL($P(DATA,U,8),.XIP)
  1.  S XSTATE=$G(XIP("STATE"))
  1.  I XSTATE'="" S FDA(1,8991.9,IENS,1.6)=XSTATE  ;  6 - STATE
  1.  ;
  1.  S FDA(1,8991.9,IENS,1.7)=$P(DATA,U,8)         ;  8 - ZIP CODE
  1.  S FDA(1,8991.9,IENS,.02)=$P(DATA,U,9)         ;  9 - ACTIVITY CODE
  1.  S FDA(1,8991.9,IENS,.07)=$P(DATA,U,10)        ; 10 - TYPE
  1.  S FDA(1,8991.9,IENS,.01)=$P(DATA,U,11)        ; 11 - DEA NUMBER
  1.  S FDA(1,8991.9,IENS,.04)=$P(DATA,U,12)        ; 12 - EXPIRATION DATE
  1.  S FDA(1,8991.9,IENS,10.2)="N"                 ; 13 - PROCESSED DATE
  1.  I $$DEANUM^PSODEAUT($P(DATA,U,14)) D                   ; ONLY CLEAR AND SET IF VALIDATED
  1.  . I $P(DATA,U,14)'="" D CLEARDTX^PSODEAUT(NPIEN)       ; REMOVE DETOX NUMBERS FROM OTHER DEA NUMBERS
  1.  . S FDA(1,8991.9,IENS,.03)=$P(DATA,U,14)      ; 14 - DETOX NUMBER
  1.  I $P(DATA,U,10)="INDIVIDUAL" D
  1.  . S FDA(1,8991.9,IENS,2.1)=$P(DATA,U,15)        ; 15 - SCHEDULE II NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.2)=$P(DATA,U,16)        ; 16 - SCHEDULE II NON-NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.3)=$P(DATA,U,17)        ; 17 - SCHEDULE III NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.4)=$P(DATA,U,18)        ; 18 - SCHEDULE III NON-NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.5)=$P(DATA,U,19)        ; 19 - SCHEDULE IV
  1.  . S FDA(1,8991.9,IENS,2.6)=$P(DATA,U,20)        ; 20 - SCHEDULE V
  1.  I $P(DATA,U,10)'="INDIVIDUAL" D
  1.  . N SRET,SDEA
  1.  . S SDEA=$P(DATA,U,11) ;dea number
  1.  . D DEADOJ^PSODEAUT(.SRET,SDEA) ;call doj server for doj institutional schedules
  1.  . I SRET(0) D  ;doj server is up
  1.  . . S FDA(1,8991.9,IENS,2.1)=$P(SRET(1),"^",15) ; 15 - SCHEDULE II NARCOTIC
  1.  . . S FDA(1,8991.9,IENS,2.2)=$P(SRET(1),"^",16) ; 16 - SCHEDULE II NON-NARCOTIC
  1.  . . S FDA(1,8991.9,IENS,2.3)=$P(SRET(1),"^",17) ; 17 - SCHEDULE III NARCOTIC
  1.  . . S FDA(1,8991.9,IENS,2.4)=$P(SRET(1),"^",18) ; 18 - SCHEDULE III NON-NARCOTIC
  1.  . . S FDA(1,8991.9,IENS,2.5)=$P(SRET(1),"^",19) ; 19 - SCHEDULE IV
  1.  . . S FDA(1,8991.9,IENS,2.6)=$P(SRET(1),"^",20) ; 20 - SCHEDULE V
  1.  . ;
  1.  S FDA(1,8991.9,IENS,.06)=$P(DATA,U,21)        ; 21 - USE FOR INPATIENT FLAG
  1.  S SUFFIX=$P(DATA,U,22)                        ; 22 - DEA INSTITUTIONAL SUFFIX
  1.  ;
  1.  D UPDATE^DIE("E","FDA(1)","IENROOT","MSGROOT")
  1.  I $D(MSGROOT) S RET="0^DATA DIDN'T FILE SUCCESSFULLY." G FILEFMX
  1.  S DNDEAIEN=$S($D(IENROOT(1)):IENROOT(1)_",",1:IENS)
  1.  I '+DNDEAIEN S RET="0^DATA DIDN'T FILE SUCCESSFULLY." G FILEFMX
  1.  S FDA(2,8991.9,DNDEAIEN,10.1)=$G(DUZ) D FILE^DIE("","FDA(2)","MSGROOT")
  1.  S:DNDEAIEN RET=+DNDEAIEN_"^SUCCESSFULLY SAVED/UPDATED IN 8991.9"
  1.  I $L(DNDEATXT),$G(NPIEN),$G(DNDEAIEN) S RET=RET_"^"_$$NPFILE^PSODEAUT(DNDEATXT,NPIEN,DNDEAIEN,SUFFIX)
  1.  I RET,$P(DATA,U,21)="YES" S FDA(200,NPIEN_",",53.2)=$P(DATA,U,11) D UPDATE^DIE(,"FDA")
  1.  I $P(RET,"^",3),$G(NPIEN),$P($G(DATA),"^",10)'="INDIVIDUAL" S RET=RET_"^"_$$NPSFILE^PSOEPUT(NPIEN,DATA)
  1. FILEFMX  ; -- Subroutine Exit Point
  1.  Q
  1.  ;
  1. DNDEAGET(RET,DEA) ;
  1.  I '$D(^XTV(8991.9,"B",DEA)) S RET(0)="0^DEA NOT ON FILE" Q
  1.  I $D(^XTV(8991.9,"B",DEA)) S DNDEAIEN=$O(^XTV(8991.9,"B",DEA,0)) I +DNDEAIEN D
  1.  . K DNDEADAT D GETS^DIQ(8991.9,DNDEAIEN,"**","","DNDEADAT")
  1.  . K RET(1)
  1.  . S RET(1)=""
  1.  . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.1))_"^"    ; PROVIDER NAME
  1.  . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.2))_"^"    ; ADDRESS 1
  1.  . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.3))_"^"    ; ADDRESS 2
  1.  . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.4))_"^"    ; ADDRESS 3
  1.  . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.5))_"^"    ; CITY
  1.  . ;
  1.  . ; Special State Processing
  1.  . N XSTATE,XSTATEAB,XIP,BAC,X,Y D POSTAL^XIPUTIL($G(DNDEADAT(8991.9,DNDEAIEN_",",1.7)),.XIP)
  1.  . S XSTATEAB=$$GET1^DIQ(5,XIP("STATE POINTER"),1)
  1.  . S RET(1)=RET(1)_XSTATEAB_"^"                         ; STATE ABREVIATION
  1.  . S XSTATE=$G(XIP("STATE"))
  1.  . S RET(1)=RET(1)_$G(XSTATE)_"^"                       ; STATE
  1.  . ;
  1.  . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",1.7))_"^"  ; ZIP CODE
  1.  . S BAC=$G(DNDEADAT(8991.9,DNDEAIEN_",",.02))                ; ACTIVITY CODE
  1.  . S RET(1)=RET(1)_BAC_"^"                             ; ACTIVITY CODE
  1.  . S RET(1)=RET(1)_$P($$PROVTYPE^PSODEAUT($G(BAC)),"^",2)_"^"   ; TYPE
  1.  . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",.01))_"^"  ; DEA NUMBER
  1.  . S X=$P($G(DNDEADAT(8991.9,DNDEAIEN_",",.04)),"@") D ^%DT
  1.  . S RET(1)=RET(1)_$$FMTHL7^XLFDT(Y)_"^"  ; EXPIRATION DATE
  1.  . S X=$P($G(DNDEADAT(8991.9,DNDEAIEN_",",10.2)),"@") D ^%DT
  1.  . S RET(1)=RET(1)_$$FMTHL7^XLFDT(Y)_"^" ; PROCESSED DATE
  1.  . S RET(1)=RET(1)_""_"^"                                       ; DETOX NUMBER ;P731 detox/x-waiver removal
  1.  . I $G(DNDEADAT(8991.9,DNDEAIEN_",",.07))="INDIVIDUAL" D
  1.  . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.1))_"^"  ; SCHEDULE II NARCOTIC
  1.  . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.2))_"^"  ; SCHEDULE II NON-NARCOTIC
  1.  . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.3))_"^"  ; SCHEDULE III NARCOTIC
  1.  . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.4))_"^"  ; SCHEDULE III NON-NARCOTIC
  1.  . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.5))_"^"  ; SCHEDULE IV
  1.  . . S RET(1)=RET(1)_$G(DNDEADAT(8991.9,DNDEAIEN_",",2.6))      ; SCHEDULE V
  1.  . I $G(DNDEADAT(8991.9,DNDEAIEN_",",.07))'="INDIVIDUAL" D
  1.  . . S RET(1)=RET(1)_"^"  ; SCHEDULE II NARCOTIC
  1.  . . S RET(1)=RET(1)_"^"  ; SCHEDULE II NON-NARCOTIC
  1.  . . S RET(1)=RET(1)_"^"  ; SCHEDULE III NARCOTIC
  1.  . . S RET(1)=RET(1)_"^"  ; SCHEDULE III NON-NARCOTIC
  1.  . . S RET(1)=RET(1)_"^"  ; SCHEDULE IV
  1.  . . S RET(1)=RET(1)_"^"  ; SCHEDULE V
  1.  S RET(0)=RET(0)_"; OFFLINE DEA DATA IN USE"