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

PSOEPUT.m

Go to the documentation of this file.
  1. PSOEPUT ;ALB/BI - DEA Manual Entry ;10/30/23 13:02
  1. ;;7.0;OUTPATIENT PHARMACY;**545,731,743**;DEC 1997;Build 24
  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. Q
  1. ;
  1. DEALIST(RET,NPIEN) ; -- RPC to return a List of DEA numbers and information for a single provider.
  1. ; INPUT: NPIEN - NEW PERSON FILE #200 INTERNAL ENTRY NUMBER
  1. ;
  1. ; OUTPUT: RET - A STRING OF DEA INFORMATION DELIMITED BY THE "^"
  1. ; 1 - DEA NUMBER
  1. ; 2 - INDIVIDUAL DEA SUFFIX
  1. ; 3 - STATE
  1. ; 4 - DETOX NUMBER
  1. ; 5 - EXPIRATION DATE: FROM THE DEA NUMBERS FILE (#8991.9), FIELD EXPIRATION DATE (#.04)
  1. ; 6 - NPIENS
  1. ; 7 - DNIENS
  1. ; 8 - SCHEDULE II NARCOTIC
  1. ; 9 - SCHEDULE II NON-NARCOTIC
  1. ; 10 - SCHEDULE III NARCOTIC
  1. ; 11 - SCHEDULE III NON-NARCOTIC
  1. ; 12 - SCHEDULE IV
  1. ; 13 - SCHEDULE V
  1. ; 14 - USE FOR INPATIENT ORDERS?
  1. ; 15 - EXPIRATION DATE, INTERNAL FORMAT
  1. ;
  1. Q:'$G(NPIEN)
  1. N CNT,DNDEADAT,DNDEAIEN,FAIL,IENS,NPDEADAT,NPDEAIEN,NPSCHED,INPAT
  1. S NPDEAIEN=0 F CNT=1:1 S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'+NPDEAIEN D
  1. . S IENS=NPDEAIEN_","_NPIEN_","
  1. . K NPDEADAT D GETS^DIQ(200.5321,IENS,"**","","NPDEADAT") Q:'$D(NPDEADAT)
  1. . S DNDEAIEN=$$GET1^DIQ(200.5321,IENS,.03,"I") Q:'DNDEAIEN
  1. . K DNDEADAT D GETS^DIQ(8991.9,DNDEAIEN,"**","","DNDEADAT") Q:'$D(DNDEADAT)
  1. . ;
  1. . S RET(CNT)=""
  1. . S RET(CNT)=RET(CNT)_NPDEADAT(200.5321,IENS,.01)_"^" ; NEW PERSON DEA NUMBER
  1. . S RET(CNT)=RET(CNT)_NPDEADAT(200.5321,IENS,.02)_"^" ; INDIVIDUAL DEA SUFFIX
  1. . S RET(CNT)=RET(CNT)_DNDEADAT(8991.9,DNDEAIEN_",",1.6)_"^" ; STATE
  1. . S RET(CNT)=RET(CNT)_""_"^" ; DETOX NUMBER ;P731 detox/x-waiver removal
  1. . S RET(CNT)=RET(CNT)_DNDEADAT(8991.9,DNDEAIEN_",",.04)_"^" ; EXPIRATION DATE
  1. . S RET(CNT)=RET(CNT)_IENS_"^" ; NEW PERSON IENS
  1. . S RET(CNT)=RET(CNT)_DNDEAIEN_"^" ; DEA NUMBERS IEN
  1. . I $G(DNDEADAT(8991.9,DNDEAIEN_",",.07))'="INDIVIDUAL" D
  1. . . K NPSCHED D GETS^DIQ(200,NPIEN_",","55.1:55.6","E","NPSCHED")
  1. . . S RET(CNT)=RET(CNT)_NPSCHED(200,NPIEN_",",55.1,"E")_"^" ; SCHEDULE II NARCOTIC
  1. . . S RET(CNT)=RET(CNT)_NPSCHED(200,NPIEN_",",55.2,"E")_"^" ; SCHEDULE II NON-NARCOTIC
  1. . . S RET(CNT)=RET(CNT)_NPSCHED(200,NPIEN_",",55.3,"E")_"^" ; SCHEDULE III NARCOTIC
  1. . . S RET(CNT)=RET(CNT)_NPSCHED(200,NPIEN_",",55.4,"E")_"^" ; SCHEDULE III NON-NARCOTIC
  1. . . S RET(CNT)=RET(CNT)_NPSCHED(200,NPIEN_",",55.5,"E")_"^" ; SCHEDULE IV
  1. . . S RET(CNT)=RET(CNT)_NPSCHED(200,NPIEN_",",55.6,"E")_"^" ; SCHEDULE V
  1. . I $G(DNDEADAT(8991.9,DNDEAIEN_",",.07))="INDIVIDUAL" D
  1. . . S RET(CNT)=RET(CNT)_DNDEADAT(8991.9,DNDEAIEN_",",2.1)_"^" ; SCHEDULE II NARCOTIC
  1. . . S RET(CNT)=RET(CNT)_DNDEADAT(8991.9,DNDEAIEN_",",2.2)_"^" ; SCHEDULE II NON-NARCOTIC
  1. . . S RET(CNT)=RET(CNT)_DNDEADAT(8991.9,DNDEAIEN_",",2.3)_"^" ; SCHEDULE III NARCOTIC
  1. . . S RET(CNT)=RET(CNT)_DNDEADAT(8991.9,DNDEAIEN_",",2.4)_"^" ; SCHEDULE III NON-NARCOTIC
  1. . . S RET(CNT)=RET(CNT)_DNDEADAT(8991.9,DNDEAIEN_",",2.5)_"^" ; SCHEDULE IV
  1. . . S RET(CNT)=RET(CNT)_DNDEADAT(8991.9,DNDEAIEN_",",2.6)_"^" ; SCHEDULE V
  1. . S INPAT=DNDEADAT(8991.9,DNDEAIEN_",",.06) S:INPAT'="YES" INPAT=""
  1. . S RET(CNT)=RET(CNT)_INPAT_"^" ; USE FOR INPATIENT ORDERS?
  1. . S RET(CNT)=RET(CNT)_$P(^XTV(8991.9,DNDEAIEN,0),"^",4) ; EXPIRATION DATE - INTERNAL
  1. Q
  1. ;
  1. DEADOJ(RET,DEA) ; -- RPC to return DEA Information for a single DEA Number
  1. ; INPUT: DEA - PROPERLY FORMATTED DEA NUMBER
  1. ;
  1. ; OUTPUT: RET - 1^A STRING OF DEA INFORMATION DELIMITED BY THE "^"
  1. ; 1 - PROVIDER NAME
  1. ; 2 - ADDRESS 1
  1. ; 3 - ADDRESS 2
  1. ; 4 - ADDRESS 3
  1. ; 5 - CITY
  1. ; 6 - STATE
  1. ; 7 - STATE POINTER
  1. ; 8 - ZIP CODE
  1. ; 9 - ACTIVITY CODE
  1. ; 10 - TYPE
  1. ; 11 - DEA NUMBER
  1. ; 12 - EXPIRATION DATE
  1. ; 13 - PROCESSED DATE
  1. ; 14 - DETOX NUMBER
  1. ; 15 - SCHDEULE II NARCOTIC
  1. ; 16 - SCHEDULE II NON-NARCOTIC
  1. ; 17 - SCHEDULE III NARCOTIC
  1. ; 18 - SCHEDULE III NON-NARCOTIC
  1. ; 19 - SCHEDULE IV
  1. ; 20 - SCHEDULE V
  1. ;
  1. ; OUTPUT WITH AN ERROR: RET - 0^ERROR NUMBER^ERROR TEXT
  1. ; 0^1^Missing DEA Number
  1. ; 0^2^Invalid DEA Number due to error in first letter
  1. ; 0^3^Invalid DEA Number due to error in second letter
  1. ; 0^4^Invalid DEA Number due to error in the numbers
  1. ; 0^5^DEA Number not found. Please enter the provider's DEA number.
  1. ; 0^6^Unable to Connect to PSO DOJ/DEA Web Service.
  1. ; If you continue, the DEA information will not be checked against DOJ DEA source data.
  1. ; 0^7^DEA number not on file
  1. ;
  1. N FG,NAME,NPIEN,VALUE,DS,BAC,SC
  1. I $G(DEA)="" S RET(0)="0^1^Missing DEA Number" Q
  1. I '$$DEANUMFL(DEA) S RET(0)="0^2^Invalid DEA Number due to error in first letter" Q
  1. I '$$DEANUMF2(DEA) S RET(0)="0^3^Invalid DEA Number due to error in second letter" Q
  1. I '$$DEANUM(DEA) S RET(0)="0^4^Invalid DEA Number due to error in the numbers" Q
  1. S SC=$$WSGET(.FG,DEA)
  1. I $P($P(SC,"^",2),".",1)="DEA NUMBER NOT FOUND" S RET(0)="0^5^DEA Number not found. Please enter the provider's DEA number." Q
  1. I 'SC D D DNDEAGET^PSOEPU1(.RET,DEA) Q
  1. . S RET(0)="0^6^Unable to Connect to PSO DOJ/DEA Web Service."
  1. . S RET(0)=RET(0)_" If you continue, the DEA information will not be checked against DOJ DEA source data."
  1. ;
  1. S RET(1)=""
  1. S RET(1)=RET(1)_$G(FG("name"))_"^" ; PROVIDER NAME
  1. S RET(1)=RET(1)_$G(FG("address1"))_"^" ; ADDRESS 1
  1. S RET(1)=RET(1)_$G(FG("address2"))_"^" ; ADDRESS 2
  1. S RET(1)=RET(1)_$G(FG("address3"))_"^" ; ADDRESS 3
  1. S RET(1)=RET(1)_$G(FG("city"))_"^" ; CITY
  1. ;
  1. ; Special State Processing
  1. S RET(1)=RET(1)_$G(FG("state"))_"^" ; STATE
  1. N XSTATE,XIP D POSTAL^XIPUTIL($G(FG("zipCode")),.XIP) S XSTATE=$G(XIP("STATE"))
  1. S RET(1)=RET(1)_$G(XSTATE)_"^" ; STATE POINTER
  1. ;
  1. S RET(1)=RET(1)_$G(FG("zipCode"))_"^" ; ZIP CODE
  1. S BAC=$G(FG("businessActivityCode"))_$G(FG("businessActivitySubcode"))
  1. S RET(1)=RET(1)_BAC_"^" ; ACTIVITY CODE
  1. S RET(1)=RET(1)_$P($$PROVTYPE($G(FG("businessActivityCode"))),"^",2)_"^" ; TYPE
  1. S RET(1)=RET(1)_$G(FG("deaNumber"))_"^" ; DEA NUMBER
  1. S RET(1)=RET(1)_$G(FG("expirationDate"))_"^" ; EXPIRATION DATE
  1. S RET(1)=RET(1)_$G(FG("processedDate"))_"^" ; PROCESSED DATE
  1. ;
  1. S DS=$G(FG("drugSchedule"))
  1. S NPIEN=$O(^VA(200,"PS4",DEA,0))
  1. S RET(1)=RET(1)_$S($$DETOXCHK^PSODEAUT(BAC):"X"_$E(FG("deaNumber"),2,9),1:"")_"^" ; DETOX NUMBER
  1. S RET(1)=RET(1)_$S(DS["22N":"YES",(DS["2"&(DS'["2N")):"YES",1:"NO")_"^" ; SCHEDULE II NARCOTIC
  1. S RET(1)=RET(1)_$S(DS["2N":"YES",1:"NO")_"^" ; SCHEDULE II NON-NARCOTIC
  1. S RET(1)=RET(1)_$S(DS["33N":"YES",DS["3"&(DS'["3N"):"YES",1:"NO")_"^" ; SCHEDULE III NARCOTIC
  1. S RET(1)=RET(1)_$S(DS["3N":"YES",1:"NO")_"^" ; SCHEDULE III NON-NARCOTIC
  1. S RET(1)=RET(1)_$S(DS["4":"YES",1:"NO")_"^" ; SCHEDULE IV
  1. S RET(1)=RET(1)_$S(DS["5":"YES",1:"NO") ; SCHEDULE V
  1. S RET(0)="1^SUCCESS"
  1. Q
  1. ;
  1. DEAREM(RET,NPIEN,DEATXT) ; Functionality to remove a DEA multiple from file #200, Field 53.21
  1. N RETURN S RETURN=""
  1. D DELMULT^PSOEPUT2(.RETURN,NPIEN,DEATXT)
  1. D SETINP^PSOEPU1(NPIEN)
  1. S RET=RETURN
  1. I $L($G(DEATXT)) D
  1. . N NPDEA S NPDEA=$$GET1^DIQ(200,+$G(NPIEN),53.2) Q:NPDEA=""
  1. . I (NPDEA=DEATXT)!('$O(^VA(200,+$G(NPIEN),"PS4",0))) K DIE,DA,DR,X S DIE="^VA(200,",DA=NPIEN,DR="53.2///@" D ^DIE K DIE,DR,DA
  1. Q
  1. ;
  1. VIEWFM(RET,DEA) ; -- Request for DEA Information stored in DEA NUMBERS FILE #8991.9, Return DEA Information in RET
  1. N DEAIEN,GETSTMP
  1. I $G(DEA)="" S RET(0)="0^INVALID DEA NUMBER" Q
  1. S DEAIEN=$O(^XTV(8991.9,"B",DEA,0)) I 'DEAIEN S RET(0)="0^DEA NUMBER NOT FOUND" Q
  1. D GETS^DIQ(8991.9,DEAIEN,"**","R","GETSTMP")
  1. I '$D(GETSTMP) S RET(0)="0^NO DATA FOUND" Q
  1. S RET(0)="1^SUCCESS"
  1. S CNT=0,NAME="" F S NAME=$O(GETSTMP(8991.9,DEAIEN_",",NAME)) Q:NAME="" D
  1. . S CNT=CNT+1,RET(CNT)=NAME_"^"_GETSTMP(8991.9,DEAIEN_",",NAME)
  1. Q
  1. ;
  1. FILEWS(RET,ARRAY) ; -- File DEA Information in ARRAY, Return the IEN Number from DEA NUMBERS FILE #8991.9
  1. N FG,NAME,VALUE,CNT
  1. F CNT=1:1:$O(ARRAY(""),-1) S FG($P(ARRAY(CNT),"^",1))=$P(ARRAY(CNT),"^",2)
  1. I $G(FG("deaNumber"))="" S RET(0)="0^INVALID DEA NUMBER" Q
  1. I '$$DEANUMFL(FG("deaNumber")) S RET(0)="0^Invalid DEA Number due to error in first letter" Q
  1. I '$$DEANUM(FG("deaNumber")) S RET(0)="0^Invalid DEA Number due to error in the numbers" Q
  1. S RET=$$DEACOPY^PSODEAUT(.FG)
  1. Q
  1. ;
  1. DEACOPY(FG) ; -- Private Subroutine to Copy import data in the GETS Array
  1. ; POSTAL^XIPUTL used in agreement with Integration Agreement: 3618
  1. ;
  1. ; INPUT: FG ;Web Service Response Global
  1. ;
  1. ; VARIABLES:
  1. N DS ;Single drug schedule field as sent from the VA DOJ Web Service.
  1. N XIP ;Used to calculate the state from a zip code.
  1. N XSTATE ;Used to calculate the state from a zip code.
  1. N BAC ;Business Activity Code
  1. N DTRESULT
  1. ;
  1. S DS=$G(FG("drugSchedule"))
  1. S GETS(.01)=$G(FG("deaNumber"))
  1. S BAC=$G(FG("businessActivityCode"))_$G(FG("businessActivitySubcode"))
  1. S GETS(.02)=BAC ; Pointer to file #8991.8
  1. S GETS(.03)=$S($$GETDNDTX^PSODEAUT(NPIEN)'="":"",$$DETOXCHK^PSODEAUT(BAC):"X"_$E($G(FG("deaNumber")),2,9),1:"") ; DETOX NUMBER
  1. D DT^DILF("E",$G(FG("expirationDate")),.DTRESULT)
  1. S GETS(.04)=$G(DTRESULT(0))
  1. S GETS(.07)=$G(FG("type"))
  1. S GETS(1.1)=$G(FG("name"))
  1. S GETS(1.2)=$G(FG("address1"))
  1. S GETS(1.3)=$G(FG("address2"))
  1. S GETS(1.4)=$G(FG("address3"))
  1. S GETS(1.5)=$G(FG("city"))
  1. ;
  1. ; Special State Processing
  1. S GETS(1.6)=$G(FG("state"))
  1. D POSTAL^XIPUTIL($G(FG("zipCode")),.XIP)
  1. S XSTATE=$G(XIP("STATE"))
  1. I XSTATE'="" S GETS(1.6)=XSTATE ; Pointer to the State File #5.
  1. ;
  1. S GETS(1.7)=$G(FG("zipCode"))
  1. ;
  1. S GETS(2.1)=$S(DS["22N":"YES",(DS["2"&(DS'["2N")):"YES",1:"NO") ; SCHEDULE II NARCOTIC
  1. S GETS(2.2)=$S(DS["2N":"YES",1:"NO") ; SCHEDULE II NON-NARCOTIC
  1. S GETS(2.3)=$S(DS["33N":"YES",(DS["3"&(DS'["3N")):"YES",1:"NO") ; SCHEDULE III NARCOTIC
  1. S GETS(2.4)=$S(DS["3N":"YES",1:"NO") ; SCHEDULE III NON-NARCOTIC
  1. S GETS(2.5)=$S(DS["4":"YES",1:"NO") ; SCHEDULE IV
  1. S GETS(2.6)=$S(DS["5":"YES",1:"NO") ; SCHEDULE V
  1. ;
  1. D DT^DILF("E",%DT,.DTRESULT)
  1. S GETS(10.2)=$G(DTRESULT(0)) ; LAST UPDATED DATE/TIME
  1. D DT^DILF("E",$G(FG("processedDate")),.DTRESULT)
  1. S GETS(10.3)=$G(DTRESULT(0)) ; LAST DOJ UPDATE DATE/TIME
  1. S GETS(10.1)=DUZ
  1. Q
  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. D FILEFM^PSOEPU1(.RET,.DATA,NPIEN)
  1. Q
  1. ;
  1. NPFILE(DNDEATXT,NPIEN,DNDEAIEN,SUFFIX) ; -- File the DEA NUMBER in the NEW PERSON FILE #200.
  1. N FDA,IEN,IENROOT,MSGROOT
  1. Q:'$G(NPIEN) Q:'$G(DNDEAIEN)
  1. S IEN="+1,"
  1. I $D(^VA(200,NPIEN,"PS4","B",DNDEATXT)) S IEN=$O(^VA(200,NPIEN,"PS4","B",DNDEATXT,0))_","
  1. S FDA(1,200.5321,IEN_NPIEN_",",.01)=DNDEATXT
  1. S FDA(1,200.5321,IEN_NPIEN_",",.02)=SUFFIX
  1. S FDA(1,200.5321,IEN_NPIEN_",",.03)=+DNDEAIEN
  1. D UPDATE^DIE("","FDA(1)","IENROOT","MSGROOT")
  1. I $D(MSGROOT) Q "0^DATA DIDN'T FILE SUCCESSFULLY IN NPFILE."
  1. D SETINP2^PSOEPU1(NPIEN,+IEN)
  1. Q "1^SUCCESSFULLY SAVED/UPDATED IN 200"
  1. ;
  1. NPSFILE(NPIEN,DATA) ; -- File the DEA institutional schedules in the NEW PERSON FILE #200.
  1. N FDA,IENROOT,MSGROOT
  1. Q:'$G(NPIEN)
  1. S FDA(3,200,NPIEN_",",55.1)=$E($P(DATA,U,15),1) ; 15 - SCHEDULE II NARCOTIC
  1. S FDA(3,200,NPIEN_",",55.2)=$E($P(DATA,U,16),1) ; 16 - SCHEDULE II NON-NARCOTIC
  1. S FDA(3,200,NPIEN_",",55.3)=$E($P(DATA,U,17),1) ; 17 - SCHEDULE III NARCOTIC
  1. S FDA(3,200,NPIEN_",",55.4)=$E($P(DATA,U,18),1) ; 18 - SCHEDULE III NON-NARCOTIC
  1. S FDA(3,200,NPIEN_",",55.5)=$E($P(DATA,U,19),1) ; 19 - SCHEDULE IV
  1. S FDA(3,200,NPIEN_",",55.6)=$E($P(DATA,U,20),1) ; 20 - SCHEDULE V
  1. D UPDATE^DIE("E","FDA(3)","IENROOT","MSGROOT")
  1. I $D(MSGROOT) Q "0^DATA DIDN'T FILE SUCCESSFULLY IN NPSFILE."
  1. Q "1^SCHEDULES SUCCESSFULLY SAVED/UPDATED IN 200"
  1. ;
  1. PROVTYPE(BA) ; -- Calculate the Provider Type from the Business Activity Code.
  1. N RESULT S RESULT="1^INSTITUTIONAL"
  1. S:$G(BA)="" RESULT="2^INDIVIDUAL"
  1. S:$E(BA)="C" RESULT="2^INDIVIDUAL"
  1. S:$E(BA)="M" RESULT="2^INDIVIDUAL"
  1. Q RESULT
  1. ;
  1. CONVNAME(CN) ; -- Set up a NAME conversion array.
  1. S CN("address1")="ADDRESS 1"
  1. S CN("address2")="ADDRESS 2"
  1. S CN("address3")="ADDRESS 3"
  1. S CN("businessActivityCode")="ACTIVITY CODE"
  1. S CN("businessActivitySubcode")="ACTIVITY SUB"
  1. S CN("city")="CITY"
  1. S CN("deaNumber")="DEA NUMBER"
  1. S CN("drugSchedule")="DRUG SCHEDULE"
  1. S CN("expirationDate")="EXPIRATION DATE"
  1. S CN("name")="NAME"
  1. S CN("processedDate")="PROCESSED DATE"
  1. S CN("state")="STATE"
  1. S CN("type")="TYPE"
  1. S CN("zipCode")="ZIP CODE"
  1. Q
  1. ;
  1. GETS(DEAIEN,GETS) ; -- Get the existing data from the DEA NUMBERS FILE #8991.9
  1. N GETSTMP
  1. D GETS^DIQ(8991.9,DEAIEN,"**","","GETSTMP")
  1. M GETS=GETSTMP(8991.9,DEAIEN_",")
  1. Q
  1. ;
  1. DEANUM(X) ; -- Check DEA # part
  1. N VA1,VA2
  1. S VA1=$E(X,3)+$E(X,5)+$E(X,7)+(2*($E(X,4)+$E(X,6)+$E(X,8)))
  1. S VA1=VA1#10,VA2=$E(X,9)
  1. Q VA1=VA2
  1. ;
  1. DEANUMFL(X) ;Check DEA # First Letter Part
  1. Q $S("ABCDEFGHIJKLMNOPQRSTUVWXYZ"[$E(X):1,1:0)
  1. ;
  1. DEANUMF2(X) ;Check DEA # First Letter Part
  1. Q $S("ABCDEFGHIJKLMNOPQRSTUVWXYZ"[$E(X):2,1:0)
  1. ;
  1. DUPCHK(RET,DEATXT,SUFFIX) ; -- Check for duplicate DEA number or duplicate SUFFIX usage.
  1. ; INPUTS: DEATXT - The text format of a DEA Number
  1. ; SUFFIX - The DEA suffix for an Institutional DEA number
  1. N NPIEN,DA,NPNAME
  1. I $G(DEATXT)="" S RET="0^No DEA number supplied" Q
  1. S SUFFIX=$G(SUFFIX)
  1. S RET="1^Success"
  1. I SUFFIX="",$D(^VA(200,"PS4",DEATXT)) D
  1. . S NPIEN=0 S NPIEN=$O(^VA(200,"PS4",DEATXT,NPIEN)) Q:NPIEN=""
  1. . S NPNAME=$$GET1^DIQ(200,NPIEN_",",.01)
  1. . S RET="0^Provider DEA number is already associated to another profile: "_NPIEN_", "_NPNAME_". Please check the number entered." Q
  1. I SUFFIX'="",$D(^VA(200,"F",DEATXT,SUFFIX)) D
  1. . S RET="0^Duplicate Usage of a SUFFIX" Q
  1. Q
  1. ;
  1. DETOXCHK(BAC) ; -- Test Business Activity Code for DEXTOX (DW)
  1. Q 0 ;P731 detox/x-waiver removal
  1. N BACIEN
  1. I $G(BAC)="" Q 0
  1. I '$D(^XTV(8991.8,"B",BAC)) Q 0
  1. S BACIEN=$O(^XTV(8991.8,"B",BAC,0)) I 'BACIEN Q 0
  1. I $$GET1^DIQ(8991.8,BACIEN,1)["DW/" Q 1
  1. Q 0
  1. ;
  1. MBM(RET) ; -- MEDS BY MAIL for ePCS GUI
  1. N SYS
  1. S RET=0
  1. S SYS=$$GET1^DIQ(59.7,1,102,"I")
  1. I SYS="MBM" S RET=1
  1. Q
  1. ;
  1. ENTRY(RESULT,INPUT) ; -- remoteprocedure
  1. NEW I,NOW
  1. SET NOW=$P($$HTE^XLFDT($H),":",1,2)
  1. FOR I=-1:0 SET I=$O(INPUT(I)) QUIT:I="" DO RECORD(INPUT(I),NOW)
  1. SET RESULT=1
  1. QUIT
  1. ;
  1. RECORD(LINE,NOW) ;
  1. N FDA,VALUE,IEN,MSG,I
  1. FOR I=1:1:5 SET VALUE=$P(LINE,U,I),FDA(8991.6,"+1,",(I/100))=VALUE
  1. SET FDA(8991.6,"+1,",.06)=NOW
  1. SET FDA(8991.6,"+1,",.07)=$P(LINE,U,6)
  1. DO UPDATE^DIE("E","FDA","IEN","MSG")
  1. QUIT
  1. ;
  1. CLEARDTX(NPIEN) ; REMOVE DETOX NUMBERS FROM ALL OF A PROVIDERS DEA NUMBERS
  1. Q "" ;P731 detox/x-waiver removal
  1. N DNDEAIEN,FDA,NPDEAIEN
  1. S NPDEAIEN=0 F S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN D
  1. . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
  1. . K FDA S FDA(1,8991.9,DNDEAIEN_",",.03)="@" D UPDATE^DIE("","FDA(1)") K FDA
  1. Q
  1. ;
  1. GETDNDTX(NPIEN) ; GET A SINGLE DETOX NUMBER FROM ALL OF A PROVIDERS DEA NUMBERS IN 8991.9
  1. Q "" ;P731 detox/x-waiver removal
  1. N GETDNDTX,DNDEAIEN,NPDEAIEN S GETDNDTX=""
  1. S NPDEAIEN=0 F S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN Q:$L(GETDNDTX) D
  1. . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I") Q:'DNDEAIEN
  1. . S GETDNDTX=$$GET1^DIQ(8991.9,DNDEAIEN_",",.03)
  1. Q GETDNDTX
  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. ; VARIABLES:
  1. N DATA ;The body portion of the RESPONSE object.
  1. N ERRORS ;Errors that may be returned from the JSON to MUMPS convertion.
  1. ; FG ;The JSON string converted to a MUMPS global.
  1. N REQUEST ;The web service object.
  1. N RESOURCE ;Input variable for the $$GET^XOBWLIB call, in this case the DEA number.
  1. N RESPJSON ;Used to store the JSON response in the DATA object into a single line string.
  1. N RESPONSE ;The response object portion of the REQUEST object.
  1. N SC ;Status Code response from the $$GET^XOBWLIB call.
  1. N SERVER ;The web server identifier.
  1. N SERVICE ;The web service identifier.
  1. N XU ;Left over variable from the XOBWLIB processes.
  1. N PSOERR ;Left over variable from the XOBWLIB processes.
  1. ;
  1. Q $$WSGET^PSOEPU1(.FG,DEA)
  1. ;