PSO7P529 ;ALB/BI - DEA INITIAL IMPORT ;5/5/21 06:52
;;7.0;OUTPATIENT PHARMACY;**529**;DEC 1997;Build 94
;External reference to sub-file NEW DEA #S (#200.5321) is supported by DBIA 7000
;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
Q
;
INITLOAD(LIFE) ; -- main entry point for DEA INITIAL IMPORT
N DEA,FG,NPIEN,NPDATA,NPNAME,DEAIEN,PHANDLE,PSOLDHNDL
S PSOLDHNDL=$O(^XTMP("PSODEAWB-")) I PSOLDHNDL["PSODEAWB" K ^XTMP(PSOLDHNDL) ; Remove last batch of Exceptions from ^XTMP
S:'$D(LIFE) LIFE=90
S PHANDLE=$$INITXTMP("PSODEAWB","DEA INITIAL IMPORT",LIFE)
S ^TMP($J,"PSODEAWB")=1
S DEA="A"
F S DEA=$O(^VA(200,"PS1",DEA)) Q:DEA="" D
. N FILERR,ERRCODE,FG
. S NPIEN=$O(^VA(200,"PS1",DEA,0))
. S NPNAME=$$GET1^DIQ(200,NPIEN,.01)
. D BMES^XPDUTL(DEA_" "_NPNAME)
. S SC=$$GET(.FG,DEA)
. S ERRCODE=SC
. I 'SC I ERRCODE'[404 D LOG(.FG,NPIEN,PHANDLE,"WEB SERVICE ISSUE") Q
. I 'SC I $G(ERRCODE)[404 D LOG(.FG,NPIEN,PHANDLE,"DEA# NOT FOUND IN DOJ FILE") Q
. I $P(FG("name"),",",1)'=$P(NPNAME,",",1) D LOG(.FG,NPIEN,PHANDLE,"NAME MISMATCH") Q
. I $E($G(FG("businessActivityCode")))'=""&($E($G(FG("businessActivityCode")))'="A")&($E($G(FG("businessActivityCode")))'="C") D LOG(.FG,NPIEN,PHANDLE,"INSTITUTIONAL DEA# REQUIRES INDIVIDUAL DEA SUFFIX") Q
. I $D(^XTV(8991.9,"B",DEA)) D LOG(.FG,NPIEN,PHANDLE,"DUPLICATE DEA NUMBER") Q
. K DEAIEN S SC=$$DEAFILE(DEA,NPIEN,PHANDLE,.FG,.DEAIEN) I 'SC D LOG(.FG,NPIEN,PHANDLE,"DATA FILING ISSUE. "_$P($G(SC),"^",2)) Q
. D NPFILE(DEA,NPIEN,DEAIEN,.FILERR) I $G(FILERR)'="" D LOG(.FG,NPIEN,PHANDLE,"MIGRATION DATA NOT FILED. "_FILERR) Q
K ^TMP($J,"PSODEAWB")
D TMPMSG
D BMES^XPDUTL(" *******************************************************")
D BMES^XPDUTL(" The patch post installation process is complete. ")
D BMES^XPDUTL(" The DEA data migration was successful. ")
D BMES^XPDUTL(" *******************************************************")
Q
;
GET(FG,DEA) ; Function to Get the Remote DEA information, Return in FG.
N DATA,ERRORS,PATH,REQUEST,RESOURCE,RESPJSON,RESPONSE,SC,SERVER,SERVICE,PSOERR
Q:$G(DEA)="" "0^No DEA Number Entered."
S SERVER="PSO DOJ/DEA WEB SERVER"
S SERVICE="PSO DOJ/DEA WEB SERVICE"
S RESOURCE=DEA
;
; Get an instance of the REST request object.
S REQUEST=$$GETREST^XOBWLIB(SERVICE,SERVER)
;
; Execute the HTTP Get method.
S SC=$$GET^XOBWLIB(REQUEST,RESOURCE,.PSOERR,0)
I 'SC Q "0^General Service Error"_PSOERR.code
;
; Process the response.
S RESPONSE=REQUEST.HttpResponse
S DATA=RESPONSE.Data
S RESPJSON=""
F Q:DATA.AtEnd Set RESPJSON=RESPJSON_DATA.ReadLine()
S RESPJSON=$TR(RESPJSON,$C(10),"")
I RESPJSON="" Q "0^No DEA Found."
;
; Decode the JSON format into a MUMPS global in FG
D DECODE^XLFJSON("RESPJSON","FG","ERRORS")
;
; Default the businessActivitySubcode.
I $G(FG("businessActivitySubcode"))="" S FG("businessActivitySubcode")=0
;
Q "1^Success"
;
LOG(FG,NPIEN,PHANDLE,REASON) ; -- Log import issues
N CNT,FLD,IENS,TR
D GETS^DIQ(200,NPIEN,".01;1;8;28;41.99;53.2;53.9","R","TR")
S IENS=$O(TR(200,""))
S ^XTMP(PHANDLE,0,0)=$G(^XTMP(PHANDLE,0,0))+1,CNT=^XTMP(PHANDLE,0,0)
S ^XTMP(PHANDLE,CNT,"LOCAL","DUZ")=NPIEN
M ^XTMP(PHANDLE,CNT,"WS")=FG,^XTMP(PHANDLE,CNT,"LOCAL")=TR(200,IENS)
S ^XTMP(PHANDLE,CNT,"Exception")=REASON
Q
;
DEAFILE(DEA,NPIEN,PHANDLE,FG,DEAIEN) ; -- File the import data in DEA NUMBERS FILE #8991.9
; POSTAL^XIPUTL used in agreement with Integration Agreement: 3618
N ED,FDA,IENS,IENROOT,MSGROOT,NPDETOX,SC,XIP,XSTATE,SCH200,SCHFLD,SCHCNT,BAC,SCH200ST,DUPDXDEA
N DS S DS=$$UP^XLFSTR($G(FG("drugSchedule")))
S SC="1^SUCCESS"
S IENS=$S($D(DEAIEN):DEAIEN_",",1:"+1,")
S FDA(1,8991.9,IENS,.01)=DEA
S FDA(1,8991.9,IENS,.02)=$G(FG("businessActivityCode"))_$G(FG("businessActivitySubcode")) ; Pointer to file #8991.8
S BAC=$G(FG("businessActivityCode"))_$G(FG("businessActivitySubcode"))
S FDA(1,8991.9,IENS,.03)=$S($$DETOXCHK^PSODEAUT(BAC):"X"_$E(DEA,2,9),1:"") ; DETOX NUMBER
;
; DETOX DIFFERENCE LOGGING BUT NOT QUITTING
S NPDETOX=$$GET1^DIQ(200,NPIEN_",",53.11)
I NPDETOX'="",'$$DETOXCHK^PSODEAUT(BAC) D LOG(.FG,NPIEN,PHANDLE,"DETOX NUMBER "_NPDETOX_" DOESN'T MATCH BUSINESS ACTIVITY CODE.")
I NPDETOX'="",$$DETOXCHK^PSODEAUT(BAC),NPDETOX'=("X"_$E(DEA,2,9)) D LOG(.FG,NPIEN,PHANDLE,"Existing DETOX "_NPDETOX_" and CALCULATED DETOX "_"X"_$E(DEA,2,9)_" MISMATCH.")
N CMPDETOX S CMPDETOX=$G(FDA(1,8991.9,IENS,.03))
I CMPDETOX'="" I $$DETOXDUP^PSODEAUT(DEA,CMPDETOX,.DUPDXDEA) D LOG(.FG,NPIEN,PHANDLE,"Duplicate computed DETOX number "_CMPDETOX_" not filed.") D
. S FDA(1,8991.9,IENS,.03)="" ; Don't file duplicate DETOX
;
S FDA(1,8991.9,IENS,.04)=$G(FG("expirationDate"))
S FDA(1,8991.9,IENS,.06)=1 ; Setting all providers = INPATIENT for initial load.
S FDA(1,8991.9,IENS,.07)=2 ; Setting all providers = INDIVIDUAL for initial load.
S FDA(1,8991.9,IENS,1.1)=$G(FG("name"))
S FDA(1,8991.9,IENS,1.2)=$G(FG("additionalCompanyInfo"))
S FDA(1,8991.9,IENS,1.3)=$G(FG("address1"))
S FDA(1,8991.9,IENS,1.4)=$G(FG("address2"))
S FDA(1,8991.9,IENS,1.5)=$G(FG("city"))
;
; Special State Processing
D POSTAL^XIPUTIL($G(FG("zipCode")),.XIP)
S XSTATE=$G(XIP("STATE"))
I XSTATE'="" S FDA(1,8991.9,IENS,1.6)=XSTATE ; Pointer to the State File #5.
;
S FDA(1,8991.9,IENS,1.7)=$G(FG("zipCode"))
;
D GETS^DIQ(200,NPIEN_",","55.1:55.6","I","SCH200")
S SCH200ST=""
S SCHCNT=0 F SCHFLD=55.1:.1:55.6 S SCHCNT=SCHCNT+SCH200(200,NPIEN_",",SCHFLD,"I")
S $E(SCH200ST)=$S($G(SCH200(200,NPIEN_",",55.1,"I")):2,1:" ")
S $E(SCH200ST,2,3)=$S($G(SCH200(200,NPIEN_",",55.2,"I")):"2N",1:" ")
S $E(SCH200ST,4)=$S($G(SCH200(200,NPIEN_",",55.3,"I")):3,1:" ")
S $E(SCH200ST,5,6)=$S($G(SCH200(200,NPIEN_",",55.4,"I")):"3N",1:" ")
S $E(SCH200ST,7)=$S($G(SCH200(200,NPIEN_",",55.5,"I")):4,1:" ")
S $E(SCH200ST,8)=$S($G(SCH200(200,NPIEN_",",55.6,"I")):5,1:" ")
;
D:SCHCNT
. S FDA(1,8991.9,IENS,2.1)=$S(SCH200(200,NPIEN_",",55.1,"I"):"Y",1:"N") ; SCHEDULE II NARCOTIC
. S FDA(1,8991.9,IENS,2.2)=$S(SCH200(200,NPIEN_",",55.2,"I"):"Y",1:"N") ; SCHEDULE II NON-NARCOTIC
. S FDA(1,8991.9,IENS,2.3)=$S(SCH200(200,NPIEN_",",55.3,"I"):"Y",1:"N") ; SCHEDULE III NARCOTIC
. S FDA(1,8991.9,IENS,2.4)=$S(SCH200(200,NPIEN_",",55.4,"I"):"Y",1:"N") ; SCHEDULE III NON-NARCOTIC
. S FDA(1,8991.9,IENS,2.5)=$S(SCH200(200,NPIEN_",",55.5,"I"):"Y",1:"N") ; SCHEDULE IV
. S FDA(1,8991.9,IENS,2.6)=$S(SCH200(200,NPIEN_",",55.6,"I"):"Y",1:"N") ; SCHEDULE V
. I $TR(SCH200ST," ")'=$TR(DS," ") D LOG(.FG,NPIEN,PHANDLE,"LOCAL SCHEDULES '"_$TR(SCH200ST," ")_"' DON'T MATCH DOJ SCHEDULES '"_$TR(DS," ")_"'")
;
D:'SCHCNT
. S FDA(1,8991.9,IENS,2.1)=$S(DS["22N":"Y",(DS["2"&(DS'["2N")):"Y",1:"N") ; SCHEDULE II NARCOTIC
. S FDA(1,8991.9,IENS,2.2)=$S(DS["2N":"Y",1:"N") ; SCHEDULE II NON-NARCOTIC
. S FDA(1,8991.9,IENS,2.3)=$S(DS["33N":"Y",(DS["3"&(DS'["3N")):"Y",1:"N") ; SCHEDULE III NARCOTIC
. S FDA(1,8991.9,IENS,2.4)=$S(DS["3N":"Y",1:"N") ; SCHEDULE III NON-NARCOTIC
. S FDA(1,8991.9,IENS,2.5)=$S(DS["4":"Y",1:"N") ; SCHEDULE IV
. S FDA(1,8991.9,IENS,2.6)=$S(DS["5":"Y",1:"N") ; SCHEDULE V
. I $TR(DS," ") D LOG(.FG,NPIEN,PHANDLE,"LOCAL SCHEDULES '"_$TR(SCH200ST," ")_"' DON'T MATCH DOJ SCHEDULES '"_$TR(DS," ")_"'")
;
S FDA(1,8991.9,IENS,10.2)="N" ; LAST UPDATED DATE/TIME
;S FDA(1,8991.9,IENS,10.3)=$G(FG("processedDate")) ; LAST DOJ UPDATE DATE/TIME
; LAST DOJ UPDATE DATE/TIME not sent by DOJ - presence indicates DOJ update (not manually entered)
S FDA(1,8991.9,IENS,10.3)="N" ; LAST DOJ UPDATE DATE/TIME
;
D UPDATE^DIE("E","FDA(1)","IENROOT","MSGROOT")
I $D(MSGROOT) S SC="0^DATA NOT FILED. "_$G(MSGROOT("DIERR",1,"TEXT",1)) Q SC
S DEAIEN=$S($D(IENROOT(1)):IENROOT(1),1:IENS)
I 'DEAIEN S SC="0^DATA NOT FILED." Q SC
S FDA(2,8991.9,DEAIEN,10.1)=DUZ D FILE^DIE("","FDA(2)","MSGROOT")
Q SC
;
NPFILE(DEA,NPIEN,DEAIEN,FILERR) ; -- File the DEA NUMBER in the NEW PERSON FILE #200.
N FDA,IENROOT,MSGROOT
Q:'$G(NPIEN) Q:'$G(DEAIEN)
S FDA(1,200.5321,"+1,"_NPIEN_",",.01)=DEA
S FDA(1,200.5321,"+1,"_NPIEN_",",.02)=""
S FDA(1,200.5321,"+1,"_NPIEN_",",.03)=+DEAIEN
D UPDATE^DIE("","FDA(1)","IENROOT","MSGROOT")
I $D(MSGROOT) S FILERR=$G(MSGROOT("DIERR",1,"TEXT",1)) I FILERR="" S FILERR="MIGRATION DATA NOT FILED"
Q
;
INITXTMP(NAMESPC,TITLE,LIFE) ; -- Initialize ^XTMP according to SAC standards.
N BEGDT,PURGDT
S BEGDT=$$NOW^XLFDT()
S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
S NAMESPC=NAMESPC_"-"_BEGDT_"-"_$J
S ^XTMP(NAMESPC,0)=PURGDT_"^"_BEGDT_"^"_TITLE
Q NAMESPC
;
TMPMSG ; Send MailMan LOG REPORT
N CNT,OBJ,PHANDLE,XMSUB,XMDUZ,PSOCNT,PSODASH,EXREAS,PSOXMD,PSOLDXMD
S $P(PSODASH,"-",80)=""
S PHANDLE=$O(^XTMP("PSODEAWB"_"-"_($H+1)),-1)
S PSOXMD=$$INITXTMP("PSOXMD","DEA INITIAL IMPORT",$S($G(LIFE):LIFE,1:90))
S PSOLDXMD=$O(^XTMP("PSOXMD")) I PSOLDXMD["PSOXMD" K ^XTMP(PSOLDXMD)
S XMSUB="DEA Migration Exception Report "_$$FMTE^XLFDT(DT,"5DZ"),XMDUZ=.5
K XMY S NPIEN=0 F S NPIEN=$O(^XUSEC("PSDMGR",NPIEN)) Q:'+NPIEN S XMY(NPIEN)=""
K PSOTEXT S PSOCNT=0
N DEAWORK
F CNT=1:1:$G(^XTMP(PHANDLE,0,0)) D
. K OBJ M OBJ=^XTMP(PHANDLE,CNT)
. I CNT>1,($G(DEAWORK)=OBJ("LOCAL","DEA#")) D Q ; Create DEA grouping for multiple exceptions on one DEA number
. . S EXREAS=$$LJ^XLFSTR(OBJ("Exception"),"138T")
. . N EXREAS1 S EXREAS1=$E(EXREAS,1,68) S EXREAS1=$P(EXREAS1," ",1,$L(EXREAS1," ")-1)
. . S PSOCNT=PSOCNT+1,^XTMP(PSOXMD,$J,PSOCNT,0)="EXCEPTION: "_$E(EXREAS,1,$L(EXREAS1)) ; 79
. . I $TR($E(EXREAS,$L(EXREAS1)+1,999)," ","")'="" S PSOCNT=PSOCNT+1,PSOTEXT(PSOCNT)=$E(EXREAS,$L(EXREAS1)+1,150)
. . S PSOCNT=$G(PSOCNT)+1
. ;
. S ^XTMP(PSOXMD,$J,PSOCNT,0)=PSODASH
. S PSOCNT=PSOCNT+1
. S ^XTMP(PSOXMD,$J,PSOCNT,0)="PROVIDER NAME: "_$$LJ^XLFSTR(OBJ("LOCAL","NAME"),"35T")_" " ; 52
. S ^XTMP(PSOXMD,$J,PSOCNT,0)=^XTMP(PSOXMD,$J,PSOCNT,0)_"INITIALS: "_$$LJ^XLFSTR(OBJ("LOCAL","INITIAL"),"5T")_" " ; 16
. ;
. If OBJ("LOCAL","NAME")'=$G(OBJ("WS","name")) D
.. S PSOCNT=PSOCNT+1
.. S ^XTMP(PSOXMD,$J,PSOCNT,0)="DOJ PROVIDER NAME: "_$$LJ^XLFSTR($G(OBJ("WS","name")),"35T") ; 54
. ;
. S PSOCNT=PSOCNT+1
. S ^XTMP(PSOXMD,$J,PSOCNT,0)="TITLE: "_$$LJ^XLFSTR(OBJ("LOCAL","TITLE"),"30T")_" " ; 39
. S ^XTMP(PSOXMD,$J,PSOCNT,0)=^XTMP(PSOXMD,$J,PSOCNT,0)_"DUZ: "_$$LJ^XLFSTR(OBJ("LOCAL","DUZ"),"10T") ; 15
. ;
. S PSOCNT=PSOCNT+1
. S ^XTMP(PSOXMD,$J,PSOCNT,0)="NPI: "_$$LJ^XLFSTR(OBJ("LOCAL","NPI"),"10T")_" " ; 27
. S ^XTMP(PSOXMD,$J,PSOCNT,0)=^XTMP(PSOXMD,$J,PSOCNT,0)_"DEA#: "_$$LJ^XLFSTR(OBJ("LOCAL","DEA#"),"10T")_" " ; 27
. S ^XTMP(PSOXMD,$J,PSOCNT,0)=^XTMP(PSOXMD,$J,PSOCNT,0)_"MAIL CODE: "_$$LJ^XLFSTR(OBJ("LOCAL","MAIL CODE"),"10T") ; 21
. ;
. S PSOCNT=PSOCNT+1,^XTMP(PSOXMD,$J,PSOCNT,0)="REMARKS: "_$$LJ^XLFSTR(OBJ("LOCAL","REMARKS"),"60T") ; 69
. ;
. S EXREAS=$$LJ^XLFSTR(OBJ("Exception"),"138T")
. N EXREAS1 S EXREAS1=$E(EXREAS,1,68) S EXREAS1=$P(EXREAS1," ",1,$L(EXREAS1," ")-1)
. S PSOCNT=PSOCNT+1,^XTMP(PSOXMD,$J,PSOCNT,0)="EXCEPTION: "_$E(EXREAS,1,$L(EXREAS1)) ; 79
. I $TR($E(EXREAS,$L(EXREAS1)+1,999)," ","")'="" S PSOCNT=PSOCNT+1,^XTMP(PSOXMD,$J,PSOCNT,0)=$E(EXREAS,$L(EXREAS1)+1,150)
. ;
. S PSOCNT=PSOCNT+1 ;,^XTMP(PSOXMD,$J,PSOCNT,0)=PSODASH
. S DEAWORK=OBJ("LOCAL","DEA#")
. ;
S PSOCNT=PSOCNT+1
S ^XTMP(PSOXMD,$J,PSOCNT,0)=PSODASH
S XMY(DUZ)="" N DIFROM S XMTEXT="^XTMP("""_PSOXMD_""","_$J_"," D ^XMD K DIFROM
K PSOTEXT,XMTEXT
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO7P529 11804 printed Apr 09, 2024@21:33:23 Page 2
PSO7P529 ;ALB/BI - DEA INITIAL IMPORT ;5/5/21 06:52
+1 ;;7.0;OUTPATIENT PHARMACY;**529**;DEC 1997;Build 94
+2 ;External reference to sub-file NEW DEA #S (#200.5321) is supported by DBIA 7000
+3 ;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
+4 QUIT
+5 ;
INITLOAD(LIFE) ; -- main entry point for DEA INITIAL IMPORT
+1 NEW DEA,FG,NPIEN,NPDATA,NPNAME,DEAIEN,PHANDLE,PSOLDHNDL
+2 ; Remove last batch of Exceptions from ^XTMP
SET PSOLDHNDL=$ORDER(^XTMP("PSODEAWB-"))
IF PSOLDHNDL["PSODEAWB"
KILL ^XTMP(PSOLDHNDL)
+3 if '$DATA(LIFE)
SET LIFE=90
+4 SET PHANDLE=$$INITXTMP("PSODEAWB","DEA INITIAL IMPORT",LIFE)
+5 SET ^TMP($JOB,"PSODEAWB")=1
+6 SET DEA="A"
+7 FOR
SET DEA=$ORDER(^VA(200,"PS1",DEA))
if DEA=""
QUIT
Begin DoDot:1
+8 NEW FILERR,ERRCODE,FG
+9 SET NPIEN=$ORDER(^VA(200,"PS1",DEA,0))
+10 SET NPNAME=$$GET1^DIQ(200,NPIEN,.01)
+11 DO BMES^XPDUTL(DEA_" "_NPNAME)
+12 SET SC=$$GET(.FG,DEA)
+13 SET ERRCODE=SC
+14 IF 'SC
IF ERRCODE'[404
DO LOG(.FG,NPIEN,PHANDLE,"WEB SERVICE ISSUE")
QUIT
+15 IF 'SC
IF $GET(ERRCODE)[404
DO LOG(.FG,NPIEN,PHANDLE,"DEA# NOT FOUND IN DOJ FILE")
QUIT
+16 IF $PIECE(FG("name"),",",1)'=$PIECE(NPNAME,",",1)
DO LOG(.FG,NPIEN,PHANDLE,"NAME MISMATCH")
QUIT
+17 IF $EXTRACT($GET(FG("businessActivityCode")))'=""&($EXTRACT($GET(FG("businessActivityCode")))'="A")&($EXTRACT($GET(FG("businessActivityCode")))'="C")
DO LOG(.FG,NPIEN,PHANDLE,"INSTITUTIONAL DEA# REQUIRES INDIVIDUAL DEA SUFFIX")
QUIT
+18 IF $DATA(^XTV(8991.9,"B",DEA))
DO LOG(.FG,NPIEN,PHANDLE,"DUPLICATE DEA NUMBER")
QUIT
+19 KILL DEAIEN
SET SC=$$DEAFILE(DEA,NPIEN,PHANDLE,.FG,.DEAIEN)
IF 'SC
DO LOG(.FG,NPIEN,PHANDLE,"DATA FILING ISSUE. "_$PIECE($GET(SC),"^",2))
QUIT
+20 DO NPFILE(DEA,NPIEN,DEAIEN,.FILERR)
IF $GET(FILERR)'=""
DO LOG(.FG,NPIEN,PHANDLE,"MIGRATION DATA NOT FILED. "_FILERR)
QUIT
End DoDot:1
+21 KILL ^TMP($JOB,"PSODEAWB")
+22 DO TMPMSG
+23 DO BMES^XPDUTL(" *******************************************************")
+24 DO BMES^XPDUTL(" The patch post installation process is complete. ")
+25 DO BMES^XPDUTL(" The DEA data migration was successful. ")
+26 DO BMES^XPDUTL(" *******************************************************")
+27 QUIT
+28 ;
GET(FG,DEA) ; Function to Get the Remote DEA information, Return in FG.
+1 NEW DATA,ERRORS,PATH,REQUEST,RESOURCE,RESPJSON,RESPONSE,SC,SERVER,SERVICE,PSOERR
+2 if $GET(DEA)=""
QUIT "0^No DEA Number Entered."
+3 SET SERVER="PSO DOJ/DEA WEB SERVER"
+4 SET SERVICE="PSO DOJ/DEA WEB SERVICE"
+5 SET RESOURCE=DEA
+6 ;
+7 ; Get an instance of the REST request object.
+8 SET REQUEST=$$GETREST^XOBWLIB(SERVICE,SERVER)
+9 ;
+10 ; Execute the HTTP Get method.
+11 SET SC=$$GET^XOBWLIB(REQUEST,RESOURCE,.PSOERR,0)
+12 IF 'SC
QUIT "0^General Service Error"_PSOERR.code
+13 ;
+14 ; Process the response.
+15 SET RESPONSE=REQUEST.HttpResponse
+16 SET DATA=RESPONSE.Data
+17 SET RESPJSON=""
+18 FOR
if DATA.AtEnd
QUIT
SET RESPJSON=RESPJSON_DATA.ReadLine()
+19 SET RESPJSON=$TRANSLATE(RESPJSON,$CHAR(10),"")
+20 IF RESPJSON=""
QUIT "0^No DEA Found."
+21 ;
+22 ; Decode the JSON format into a MUMPS global in FG
+23 DO DECODE^XLFJSON("RESPJSON","FG","ERRORS")
+24 ;
+25 ; Default the businessActivitySubcode.
+26 IF $GET(FG("businessActivitySubcode"))=""
SET FG("businessActivitySubcode")=0
+27 ;
+28 QUIT "1^Success"
+29 ;
LOG(FG,NPIEN,PHANDLE,REASON) ; -- Log import issues
+1 NEW CNT,FLD,IENS,TR
+2 DO GETS^DIQ(200,NPIEN,".01;1;8;28;41.99;53.2;53.9","R","TR")
+3 SET IENS=$ORDER(TR(200,""))
+4 SET ^XTMP(PHANDLE,0,0)=$GET(^XTMP(PHANDLE,0,0))+1
SET CNT=^XTMP(PHANDLE,0,0)
+5 SET ^XTMP(PHANDLE,CNT,"LOCAL","DUZ")=NPIEN
+6 MERGE ^XTMP(PHANDLE,CNT,"WS")=FG,^XTMP(PHANDLE,CNT,"LOCAL")=TR(200,IENS)
+7 SET ^XTMP(PHANDLE,CNT,"Exception")=REASON
+8 QUIT
+9 ;
DEAFILE(DEA,NPIEN,PHANDLE,FG,DEAIEN) ; -- File the import data in DEA NUMBERS FILE #8991.9
+1 ; POSTAL^XIPUTL used in agreement with Integration Agreement: 3618
+2 NEW ED,FDA,IENS,IENROOT,MSGROOT,NPDETOX,SC,XIP,XSTATE,SCH200,SCHFLD,SCHCNT,BAC,SCH200ST,DUPDXDEA
+3 NEW DS
SET DS=$$UP^XLFSTR($GET(FG("drugSchedule")))
+4 SET SC="1^SUCCESS"
+5 SET IENS=$SELECT($DATA(DEAIEN):DEAIEN_",",1:"+1,")
+6 SET FDA(1,8991.9,IENS,.01)=DEA
+7 ; Pointer to file #8991.8
SET FDA(1,8991.9,IENS,.02)=$GET(FG("businessActivityCode"))_$GET(FG("businessActivitySubcode"))
+8 SET BAC=$GET(FG("businessActivityCode"))_$GET(FG("businessActivitySubcode"))
+9 ; DETOX NUMBER
SET FDA(1,8991.9,IENS,.03)=$SELECT($$DETOXCHK^PSODEAUT(BAC):"X"_$EXTRACT(DEA,2,9),1:"")
+10 ;
+11 ; DETOX DIFFERENCE LOGGING BUT NOT QUITTING
+12 SET NPDETOX=$$GET1^DIQ(200,NPIEN_",",53.11)
+13 IF NPDETOX'=""
IF '$$DETOXCHK^PSODEAUT(BAC)
DO LOG(.FG,NPIEN,PHANDLE,"DETOX NUMBER "_NPDETOX_" DOESN'T MATCH BUSINESS ACTIVITY CODE.")
+14 IF NPDETOX'=""
IF $$DETOXCHK^PSODEAUT(BAC)
IF NPDETOX'=("X"_$EXTRACT(DEA,2,9))
DO LOG(.FG,NPIEN,PHANDLE,"Existing DETOX "_NPDETOX_" and CALCULATED DETOX "_"X"_$EXTRACT(DEA,2,9)_" MISMATCH.")
+15 NEW CMPDETOX
SET CMPDETOX=$GET(FDA(1,8991.9,IENS,.03))
+16 IF CMPDETOX'=""
IF $$DETOXDUP^PSODEAUT(DEA,CMPDETOX,.DUPDXDEA)
DO LOG(.FG,NPIEN,PHANDLE,"Duplicate computed DETOX number "_CMPDETOX_" not filed.")
Begin DoDot:1
+17 ; Don't file duplicate DETOX
SET FDA(1,8991.9,IENS,.03)=""
End DoDot:1
+18 ;
+19 SET FDA(1,8991.9,IENS,.04)=$GET(FG("expirationDate"))
+20 ; Setting all providers = INPATIENT for initial load.
SET FDA(1,8991.9,IENS,.06)=1
+21 ; Setting all providers = INDIVIDUAL for initial load.
SET FDA(1,8991.9,IENS,.07)=2
+22 SET FDA(1,8991.9,IENS,1.1)=$GET(FG("name"))
+23 SET FDA(1,8991.9,IENS,1.2)=$GET(FG("additionalCompanyInfo"))
+24 SET FDA(1,8991.9,IENS,1.3)=$GET(FG("address1"))
+25 SET FDA(1,8991.9,IENS,1.4)=$GET(FG("address2"))
+26 SET FDA(1,8991.9,IENS,1.5)=$GET(FG("city"))
+27 ;
+28 ; Special State Processing
+29 DO POSTAL^XIPUTIL($GET(FG("zipCode")),.XIP)
+30 SET XSTATE=$GET(XIP("STATE"))
+31 ; Pointer to the State File #5.
IF XSTATE'=""
SET FDA(1,8991.9,IENS,1.6)=XSTATE
+32 ;
+33 SET FDA(1,8991.9,IENS,1.7)=$GET(FG("zipCode"))
+34 ;
+35 DO GETS^DIQ(200,NPIEN_",","55.1:55.6","I","SCH200")
+36 SET SCH200ST=""
+37 SET SCHCNT=0
FOR SCHFLD=55.1:.1:55.6
SET SCHCNT=SCHCNT+SCH200(200,NPIEN_",",SCHFLD,"I")
+38 SET $EXTRACT(SCH200ST)=$SELECT($GET(SCH200(200,NPIEN_",",55.1,"I")):2,1:" ")
+39 SET $EXTRACT(SCH200ST,2,3)=$SELECT($GET(SCH200(200,NPIEN_",",55.2,"I")):"2N",1:" ")
+40 SET $EXTRACT(SCH200ST,4)=$SELECT($GET(SCH200(200,NPIEN_",",55.3,"I")):3,1:" ")
+41 SET $EXTRACT(SCH200ST,5,6)=$SELECT($GET(SCH200(200,NPIEN_",",55.4,"I")):"3N",1:" ")
+42 SET $EXTRACT(SCH200ST,7)=$SELECT($GET(SCH200(200,NPIEN_",",55.5,"I")):4,1:" ")
+43 SET $EXTRACT(SCH200ST,8)=$SELECT($GET(SCH200(200,NPIEN_",",55.6,"I")):5,1:" ")
+44 ;
+45 if SCHCNT
Begin DoDot:1
+46 ; SCHEDULE II NARCOTIC
SET FDA(1,8991.9,IENS,2.1)=$SELECT(SCH200(200,NPIEN_",",55.1,"I"):"Y",1:"N")
+47 ; SCHEDULE II NON-NARCOTIC
SET FDA(1,8991.9,IENS,2.2)=$SELECT(SCH200(200,NPIEN_",",55.2,"I"):"Y",1:"N")
+48 ; SCHEDULE III NARCOTIC
SET FDA(1,8991.9,IENS,2.3)=$SELECT(SCH200(200,NPIEN_",",55.3,"I"):"Y",1:"N")
+49 ; SCHEDULE III NON-NARCOTIC
SET FDA(1,8991.9,IENS,2.4)=$SELECT(SCH200(200,NPIEN_",",55.4,"I"):"Y",1:"N")
+50 ; SCHEDULE IV
SET FDA(1,8991.9,IENS,2.5)=$SELECT(SCH200(200,NPIEN_",",55.5,"I"):"Y",1:"N")
+51 ; SCHEDULE V
SET FDA(1,8991.9,IENS,2.6)=$SELECT(SCH200(200,NPIEN_",",55.6,"I"):"Y",1:"N")
+52 IF $TRANSLATE(SCH200ST," ")'=$TRANSLATE(DS," ")
DO LOG(.FG,NPIEN,PHANDLE,"LOCAL SCHEDULES '"_$TRANSLATE(SCH200ST," ")_"' DON'T MATCH DOJ SCHEDULES '"_$TRANSLATE(DS," ")_"'")
End DoDot:1
+53 ;
+54 if 'SCHCNT
Begin DoDot:1
+55 ; SCHEDULE II NARCOTIC
SET FDA(1,8991.9,IENS,2.1)=$SELECT(DS["22N":"Y",(DS["2"&(DS'["2N")):"Y",1:"N")
+56 ; SCHEDULE II NON-NARCOTIC
SET FDA(1,8991.9,IENS,2.2)=$SELECT(DS["2N":"Y",1:"N")
+57 ; SCHEDULE III NARCOTIC
SET FDA(1,8991.9,IENS,2.3)=$SELECT(DS["33N":"Y",(DS["3"&(DS'["3N")):"Y",1:"N")
+58 ; SCHEDULE III NON-NARCOTIC
SET FDA(1,8991.9,IENS,2.4)=$SELECT(DS["3N":"Y",1:"N")
+59 ; SCHEDULE IV
SET FDA(1,8991.9,IENS,2.5)=$SELECT(DS["4":"Y",1:"N")
+60 ; SCHEDULE V
SET FDA(1,8991.9,IENS,2.6)=$SELECT(DS["5":"Y",1:"N")
+61 IF $TRANSLATE(DS," ")
DO LOG(.FG,NPIEN,PHANDLE,"LOCAL SCHEDULES '"_$TRANSLATE(SCH200ST," ")_"' DON'T MATCH DOJ SCHEDULES '"_$TRANSLATE(DS," ")_"'")
End DoDot:1
+62 ;
+63 ; LAST UPDATED DATE/TIME
SET FDA(1,8991.9,IENS,10.2)="N"
+64 ;S FDA(1,8991.9,IENS,10.3)=$G(FG("processedDate")) ; LAST DOJ UPDATE DATE/TIME
+65 ; LAST DOJ UPDATE DATE/TIME not sent by DOJ - presence indicates DOJ update (not manually entered)
+66 ; LAST DOJ UPDATE DATE/TIME
SET FDA(1,8991.9,IENS,10.3)="N"
+67 ;
+68 DO UPDATE^DIE("E","FDA(1)","IENROOT","MSGROOT")
+69 IF $DATA(MSGROOT)
SET SC="0^DATA NOT FILED. "_$GET(MSGROOT("DIERR",1,"TEXT",1))
QUIT SC
+70 SET DEAIEN=$SELECT($DATA(IENROOT(1)):IENROOT(1),1:IENS)
+71 IF 'DEAIEN
SET SC="0^DATA NOT FILED."
QUIT SC
+72 SET FDA(2,8991.9,DEAIEN,10.1)=DUZ
DO FILE^DIE("","FDA(2)","MSGROOT")
+73 QUIT SC
+74 ;
NPFILE(DEA,NPIEN,DEAIEN,FILERR) ; -- File the DEA NUMBER in the NEW PERSON FILE #200.
+1 NEW FDA,IENROOT,MSGROOT
+2 if '$GET(NPIEN)
QUIT
if '$GET(DEAIEN)
QUIT
+3 SET FDA(1,200.5321,"+1,"_NPIEN_",",.01)=DEA
+4 SET FDA(1,200.5321,"+1,"_NPIEN_",",.02)=""
+5 SET FDA(1,200.5321,"+1,"_NPIEN_",",.03)=+DEAIEN
+6 DO UPDATE^DIE("","FDA(1)","IENROOT","MSGROOT")
+7 IF $DATA(MSGROOT)
SET FILERR=$GET(MSGROOT("DIERR",1,"TEXT",1))
IF FILERR=""
SET FILERR="MIGRATION DATA NOT FILED"
+8 QUIT
+9 ;
INITXTMP(NAMESPC,TITLE,LIFE) ; -- Initialize ^XTMP according to SAC standards.
+1 NEW BEGDT,PURGDT
+2 SET BEGDT=$$NOW^XLFDT()
+3 SET PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
+4 SET NAMESPC=NAMESPC_"-"_BEGDT_"-"_$JOB
+5 SET ^XTMP(NAMESPC,0)=PURGDT_"^"_BEGDT_"^"_TITLE
+6 QUIT NAMESPC
+7 ;
TMPMSG ; Send MailMan LOG REPORT
+1 NEW CNT,OBJ,PHANDLE,XMSUB,XMDUZ,PSOCNT,PSODASH,EXREAS,PSOXMD,PSOLDXMD
+2 SET $PIECE(PSODASH,"-",80)=""
+3 SET PHANDLE=$ORDER(^XTMP("PSODEAWB"_"-"_($HOROLOG+1)),-1)
+4 SET PSOXMD=$$INITXTMP("PSOXMD","DEA INITIAL IMPORT",$SELECT($GET(LIFE):LIFE,1:90))
+5 SET PSOLDXMD=$ORDER(^XTMP("PSOXMD"))
IF PSOLDXMD["PSOXMD"
KILL ^XTMP(PSOLDXMD)
+6 SET XMSUB="DEA Migration Exception Report "_$$FMTE^XLFDT(DT,"5DZ")
SET XMDUZ=.5
+7 KILL XMY
SET NPIEN=0
FOR
SET NPIEN=$ORDER(^XUSEC("PSDMGR",NPIEN))
if '+NPIEN
QUIT
SET XMY(NPIEN)=""
+8 KILL PSOTEXT
SET PSOCNT=0
+9 NEW DEAWORK
+10 FOR CNT=1:1:$GET(^XTMP(PHANDLE,0,0))
Begin DoDot:1
+11 KILL OBJ
MERGE OBJ=^XTMP(PHANDLE,CNT)
+12 ; Create DEA grouping for multiple exceptions on one DEA number
IF CNT>1
IF ($GET(DEAWORK)=OBJ("LOCAL","DEA#"))
Begin DoDot:2
+13 SET EXREAS=$$LJ^XLFSTR(OBJ("Exception"),"138T")
+14 NEW EXREAS1
SET EXREAS1=$EXTRACT(EXREAS,1,68)
SET EXREAS1=$PIECE(EXREAS1," ",1,$LENGTH(EXREAS1," ")-1)
+15 ; 79
SET PSOCNT=PSOCNT+1
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)="EXCEPTION: "_$EXTRACT(EXREAS,1,$LENGTH(EXREAS1))
+16 IF $TRANSLATE($EXTRACT(EXREAS,$LENGTH(EXREAS1)+1,999)," ","")'=""
SET PSOCNT=PSOCNT+1
SET PSOTEXT(PSOCNT)=$EXTRACT(EXREAS,$LENGTH(EXREAS1)+1,150)
+17 SET PSOCNT=$GET(PSOCNT)+1
End DoDot:2
QUIT
+18 ;
+19 SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)=PSODASH
+20 SET PSOCNT=PSOCNT+1
+21 ; 52
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)="PROVIDER NAME: "_$$LJ^XLFSTR(OBJ("LOCAL","NAME"),"35T")_" "
+22 ; 16
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)=^XTMP(PSOXMD,$JOB,PSOCNT,0)_"INITIALS: "_$$LJ^XLFSTR(OBJ("LOCAL","INITIAL"),"5T")_" "
+23 ;
+24 IF OBJ("LOCAL","NAME")'=$GET(OBJ("WS","name"))
Begin DoDot:2
+25 SET PSOCNT=PSOCNT+1
+26 ; 54
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)="DOJ PROVIDER NAME: "_$$LJ^XLFSTR($GET(OBJ("WS","name")),"35T")
End DoDot:2
+27 ;
+28 SET PSOCNT=PSOCNT+1
+29 ; 39
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)="TITLE: "_$$LJ^XLFSTR(OBJ("LOCAL","TITLE"),"30T")_" "
+30 ; 15
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)=^XTMP(PSOXMD,$JOB,PSOCNT,0)_"DUZ: "_$$LJ^XLFSTR(OBJ("LOCAL","DUZ"),"10T")
+31 ;
+32 SET PSOCNT=PSOCNT+1
+33 ; 27
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)="NPI: "_$$LJ^XLFSTR(OBJ("LOCAL","NPI"),"10T")_" "
+34 ; 27
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)=^XTMP(PSOXMD,$JOB,PSOCNT,0)_"DEA#: "_$$LJ^XLFSTR(OBJ("LOCAL","DEA#"),"10T")_" "
+35 ; 21
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)=^XTMP(PSOXMD,$JOB,PSOCNT,0)_"MAIL CODE: "_$$LJ^XLFSTR(OBJ("LOCAL","MAIL CODE"),"10T")
+36 ;
+37 ; 69
SET PSOCNT=PSOCNT+1
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)="REMARKS: "_$$LJ^XLFSTR(OBJ("LOCAL","REMARKS"),"60T")
+38 ;
+39 SET EXREAS=$$LJ^XLFSTR(OBJ("Exception"),"138T")
+40 NEW EXREAS1
SET EXREAS1=$EXTRACT(EXREAS,1,68)
SET EXREAS1=$PIECE(EXREAS1," ",1,$LENGTH(EXREAS1," ")-1)
+41 ; 79
SET PSOCNT=PSOCNT+1
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)="EXCEPTION: "_$EXTRACT(EXREAS,1,$LENGTH(EXREAS1))
+42 IF $TRANSLATE($EXTRACT(EXREAS,$LENGTH(EXREAS1)+1,999)," ","")'=""
SET PSOCNT=PSOCNT+1
SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)=$EXTRACT(EXREAS,$LENGTH(EXREAS1)+1,150)
+43 ;
+44 ;,^XTMP(PSOXMD,$J,PSOCNT,0)=PSODASH
SET PSOCNT=PSOCNT+1
+45 SET DEAWORK=OBJ("LOCAL","DEA#")
+46 ;
End DoDot:1
+47 SET PSOCNT=PSOCNT+1
+48 SET ^XTMP(PSOXMD,$JOB,PSOCNT,0)=PSODASH
+49 SET XMY(DUZ)=""
NEW DIFROM
SET XMTEXT="^XTMP("""_PSOXMD_""","_$JOB_","
DO ^XMD
KILL DIFROM
+50 KILL PSOTEXT,XMTEXT
+51 ;
+52 QUIT
