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

PSO7P529.m

Go to the documentation of this file. 
  1. PSO7P529 ;ALB/BI - DEA INITIAL IMPORT ;5/5/21  06:52
  1.  ;;7.0;OUTPATIENT PHARMACY;**529**;DEC 1997;Build 94
  1.  ;External reference to sub-file NEW DEA #S (#200.5321) is supported by DBIA 7000
  1.  ;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
  1.  Q
  1.  ;
  1. INITLOAD(LIFE) ; -- main entry point for DEA INITIAL IMPORT
  1.  N DEA,FG,NPIEN,NPDATA,NPNAME,DEAIEN,PHANDLE,PSOLDHNDL
  1.  S PSOLDHNDL=$O(^XTMP("PSODEAWB-")) I PSOLDHNDL["PSODEAWB" K ^XTMP(PSOLDHNDL) ; Remove last batch of Exceptions from ^XTMP
  1.  S:'$D(LIFE) LIFE=90
  1.  S PHANDLE=$$INITXTMP("PSODEAWB","DEA INITIAL IMPORT",LIFE)
  1.  S ^TMP($J,"PSODEAWB")=1
  1.  S DEA="A"
  1.  F  S DEA=$O(^VA(200,"PS1",DEA)) Q:DEA=""  D
  1.  . N FILERR,ERRCODE,FG
  1.  . S NPIEN=$O(^VA(200,"PS1",DEA,0))
  1.  . S NPNAME=$$GET1^DIQ(200,NPIEN,.01)
  1.  . D BMES^XPDUTL(DEA_"     "_NPNAME)
  1.  . S SC=$$GET(.FG,DEA)
  1.  . S ERRCODE=SC
  1.  . I 'SC I ERRCODE'[404 D LOG(.FG,NPIEN,PHANDLE,"WEB SERVICE ISSUE") Q
  1.  . I 'SC I $G(ERRCODE)[404 D LOG(.FG,NPIEN,PHANDLE,"DEA# NOT FOUND IN DOJ FILE") Q
  1.  . I $P(FG("name"),",",1)'=$P(NPNAME,",",1) D LOG(.FG,NPIEN,PHANDLE,"NAME MISMATCH") Q
  1.  . 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
  1.  . I $D(^XTV(8991.9,"B",DEA)) D LOG(.FG,NPIEN,PHANDLE,"DUPLICATE DEA NUMBER") Q
  1.  . 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
  1.  . D NPFILE(DEA,NPIEN,DEAIEN,.FILERR) I $G(FILERR)'="" D LOG(.FG,NPIEN,PHANDLE,"MIGRATION DATA NOT FILED. "_FILERR) Q
  1.  K ^TMP($J,"PSODEAWB")
  1.  D TMPMSG
  1.  D BMES^XPDUTL("     *******************************************************")
  1.  D BMES^XPDUTL("     The patch post installation process is complete.       ")
  1.  D BMES^XPDUTL("          The DEA data migration was successful.            ")
  1.  D BMES^XPDUTL("     *******************************************************")
  1.  Q
  1.  ;
  1. GET(FG,DEA) ; Function to Get the Remote DEA information, Return in FG.
  1.  N DATA,ERRORS,PATH,REQUEST,RESOURCE,RESPJSON,RESPONSE,SC,SERVER,SERVICE,PSOERR
  1.  Q:$G(DEA)="" "0^No DEA Number Entered."
  1.  S SERVER="PSO DOJ/DEA WEB SERVER"
  1.  S SERVICE="PSO DOJ/DEA WEB SERVICE"
  1.  S RESOURCE=DEA
  1.  ;
  1.  ; Get an instance of the REST request object.
  1.  S REQUEST=$$GETREST^XOBWLIB(SERVICE,SERVER)
  1.  ;
  1.  ; Execute the HTTP Get method.
  1.  S SC=$$GET^XOBWLIB(REQUEST,RESOURCE,.PSOERR,0)
  1.  I 'SC Q "0^General Service Error"_PSOERR.code
  1.  ;
  1.  ; Process the response.
  1.  S RESPONSE=REQUEST.HttpResponse
  1.  S DATA=RESPONSE.Data
  1.  S RESPJSON=""
  1.  F  Q:DATA.AtEnd  Set RESPJSON=RESPJSON_DATA.ReadLine()
  1.  S RESPJSON=$TR(RESPJSON,$C(10),"")
  1.  I RESPJSON="" Q "0^No DEA Found."
  1.  ;
  1.  ; Decode the JSON format into a MUMPS global in FG
  1.  D DECODE^XLFJSON("RESPJSON","FG","ERRORS")
  1.  ;
  1.  ; Default the businessActivitySubcode.
  1.  I $G(FG("businessActivitySubcode"))="" S FG("businessActivitySubcode")=0
  1.  ;
  1.  Q "1^Success"
  1.  ;
  1. LOG(FG,NPIEN,PHANDLE,REASON) ; -- Log import issues
  1.  N CNT,FLD,IENS,TR
  1.  D GETS^DIQ(200,NPIEN,".01;1;8;28;41.99;53.2;53.9","R","TR")
  1.  S IENS=$O(TR(200,""))
  1.  S ^XTMP(PHANDLE,0,0)=$G(^XTMP(PHANDLE,0,0))+1,CNT=^XTMP(PHANDLE,0,0)
  1.  S ^XTMP(PHANDLE,CNT,"LOCAL","DUZ")=NPIEN
  1.  M ^XTMP(PHANDLE,CNT,"WS")=FG,^XTMP(PHANDLE,CNT,"LOCAL")=TR(200,IENS)
  1.  S ^XTMP(PHANDLE,CNT,"Exception")=REASON
  1.  Q
  1.  ;
  1. 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
  1.  N ED,FDA,IENS,IENROOT,MSGROOT,NPDETOX,SC,XIP,XSTATE,SCH200,SCHFLD,SCHCNT,BAC,SCH200ST,DUPDXDEA
  1.  N DS S DS=$$UP^XLFSTR($G(FG("drugSchedule")))
  1.  S SC="1^SUCCESS"
  1.  S IENS=$S($D(DEAIEN):DEAIEN_",",1:"+1,")
  1.  S FDA(1,8991.9,IENS,.01)=DEA
  1.  S FDA(1,8991.9,IENS,.02)=$G(FG("businessActivityCode"))_$G(FG("businessActivitySubcode")) ; Pointer to file #8991.8
  1.  S BAC=$G(FG("businessActivityCode"))_$G(FG("businessActivitySubcode"))
  1.  S FDA(1,8991.9,IENS,.03)=$S($$DETOXCHK^PSODEAUT(BAC):"X"_$E(DEA,2,9),1:"")    ; DETOX NUMBER
  1.  ;
  1.  ; DETOX DIFFERENCE LOGGING BUT NOT QUITTING
  1.  S NPDETOX=$$GET1^DIQ(200,NPIEN_",",53.11)
  1.  I NPDETOX'="",'$$DETOXCHK^PSODEAUT(BAC) D LOG(.FG,NPIEN,PHANDLE,"DETOX NUMBER "_NPDETOX_" DOESN'T MATCH BUSINESS ACTIVITY CODE.")
  1.  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.")
  1.  N CMPDETOX S CMPDETOX=$G(FDA(1,8991.9,IENS,.03))
  1.  I CMPDETOX'="" I $$DETOXDUP^PSODEAUT(DEA,CMPDETOX,.DUPDXDEA) D LOG(.FG,NPIEN,PHANDLE,"Duplicate computed DETOX number "_CMPDETOX_" not filed.") D
  1.  . S FDA(1,8991.9,IENS,.03)=""   ; Don't file duplicate DETOX
  1.  ;
  1.  S FDA(1,8991.9,IENS,.04)=$G(FG("expirationDate"))
  1.  S FDA(1,8991.9,IENS,.06)=1  ; Setting all providers = INPATIENT for initial load.
  1.  S FDA(1,8991.9,IENS,.07)=2  ; Setting all providers = INDIVIDUAL for initial load.
  1.  S FDA(1,8991.9,IENS,1.1)=$G(FG("name"))
  1.  S FDA(1,8991.9,IENS,1.2)=$G(FG("additionalCompanyInfo"))
  1.  S FDA(1,8991.9,IENS,1.3)=$G(FG("address1"))
  1.  S FDA(1,8991.9,IENS,1.4)=$G(FG("address2"))
  1.  S FDA(1,8991.9,IENS,1.5)=$G(FG("city"))
  1.  ;
  1.  ; Special State Processing
  1.  D POSTAL^XIPUTIL($G(FG("zipCode")),.XIP)
  1.  S XSTATE=$G(XIP("STATE"))
  1.  I XSTATE'="" S FDA(1,8991.9,IENS,1.6)=XSTATE ; Pointer to the State File #5.
  1.  ;
  1.  S FDA(1,8991.9,IENS,1.7)=$G(FG("zipCode"))
  1.  ;
  1.  D GETS^DIQ(200,NPIEN_",","55.1:55.6","I","SCH200")
  1.  S SCH200ST=""
  1.  S SCHCNT=0 F SCHFLD=55.1:.1:55.6 S SCHCNT=SCHCNT+SCH200(200,NPIEN_",",SCHFLD,"I")
  1.  S $E(SCH200ST)=$S($G(SCH200(200,NPIEN_",",55.1,"I")):2,1:" ")
  1.  S $E(SCH200ST,2,3)=$S($G(SCH200(200,NPIEN_",",55.2,"I")):"2N",1:"  ")
  1.  S $E(SCH200ST,4)=$S($G(SCH200(200,NPIEN_",",55.3,"I")):3,1:" ")
  1.  S $E(SCH200ST,5,6)=$S($G(SCH200(200,NPIEN_",",55.4,"I")):"3N",1:"  ")
  1.  S $E(SCH200ST,7)=$S($G(SCH200(200,NPIEN_",",55.5,"I")):4,1:" ")
  1.  S $E(SCH200ST,8)=$S($G(SCH200(200,NPIEN_",",55.6,"I")):5,1:" ")
  1.  ;
  1.  D:SCHCNT
  1.  . S FDA(1,8991.9,IENS,2.1)=$S(SCH200(200,NPIEN_",",55.1,"I"):"Y",1:"N")    ; SCHEDULE II NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.2)=$S(SCH200(200,NPIEN_",",55.2,"I"):"Y",1:"N")    ; SCHEDULE II NON-NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.3)=$S(SCH200(200,NPIEN_",",55.3,"I"):"Y",1:"N")    ; SCHEDULE III NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.4)=$S(SCH200(200,NPIEN_",",55.4,"I"):"Y",1:"N")    ; SCHEDULE III NON-NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.5)=$S(SCH200(200,NPIEN_",",55.5,"I"):"Y",1:"N")    ; SCHEDULE IV
  1.  . S FDA(1,8991.9,IENS,2.6)=$S(SCH200(200,NPIEN_",",55.6,"I"):"Y",1:"N")    ; SCHEDULE V
  1.  . I $TR(SCH200ST," ")'=$TR(DS," ") D LOG(.FG,NPIEN,PHANDLE,"LOCAL SCHEDULES '"_$TR(SCH200ST," ")_"' DON'T MATCH DOJ SCHEDULES '"_$TR(DS," ")_"'")
  1.  ;
  1.  D:'SCHCNT
  1.  . S FDA(1,8991.9,IENS,2.1)=$S(DS["22N":"Y",(DS["2"&(DS'["2N")):"Y",1:"N") ; SCHEDULE II NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.2)=$S(DS["2N":"Y",1:"N")                          ; SCHEDULE II NON-NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.3)=$S(DS["33N":"Y",(DS["3"&(DS'["3N")):"Y",1:"N") ; SCHEDULE III NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.4)=$S(DS["3N":"Y",1:"N")                          ; SCHEDULE III NON-NARCOTIC
  1.  . S FDA(1,8991.9,IENS,2.5)=$S(DS["4":"Y",1:"N")                           ; SCHEDULE IV
  1.  . S FDA(1,8991.9,IENS,2.6)=$S(DS["5":"Y",1:"N")                           ; SCHEDULE V
  1.  . I $TR(DS," ") D LOG(.FG,NPIEN,PHANDLE,"LOCAL SCHEDULES '"_$TR(SCH200ST," ")_"' DON'T MATCH DOJ SCHEDULES '"_$TR(DS," ")_"'")
  1.  ;
  1.  S FDA(1,8991.9,IENS,10.2)="N"  ; LAST UPDATED DATE/TIME
  1.  ;S FDA(1,8991.9,IENS,10.3)=$G(FG("processedDate"))  ; LAST DOJ UPDATE DATE/TIME
  1.  ; LAST DOJ UPDATE DATE/TIME not sent by DOJ - presence indicates DOJ update (not manually entered)
  1.  S FDA(1,8991.9,IENS,10.3)="N"   ; LAST DOJ UPDATE DATE/TIME
  1.  ;
  1.  D UPDATE^DIE("E","FDA(1)","IENROOT","MSGROOT")
  1.  I $D(MSGROOT) S SC="0^DATA NOT FILED. "_$G(MSGROOT("DIERR",1,"TEXT",1)) Q SC
  1.  S DEAIEN=$S($D(IENROOT(1)):IENROOT(1),1:IENS)
  1.  I 'DEAIEN S SC="0^DATA NOT FILED." Q SC
  1.  S FDA(2,8991.9,DEAIEN,10.1)=DUZ D FILE^DIE("","FDA(2)","MSGROOT")
  1.  Q SC
  1.  ;
  1. NPFILE(DEA,NPIEN,DEAIEN,FILERR) ; -- File the DEA NUMBER in the NEW PERSON FILE #200.
  1.  N FDA,IENROOT,MSGROOT
  1.  Q:'$G(NPIEN)  Q:'$G(DEAIEN)
  1.  S FDA(1,200.5321,"+1,"_NPIEN_",",.01)=DEA
  1.  S FDA(1,200.5321,"+1,"_NPIEN_",",.02)=""
  1.  S FDA(1,200.5321,"+1,"_NPIEN_",",.03)=+DEAIEN
  1.  D UPDATE^DIE("","FDA(1)","IENROOT","MSGROOT")
  1.  I $D(MSGROOT) S FILERR=$G(MSGROOT("DIERR",1,"TEXT",1)) I FILERR="" S FILERR="MIGRATION DATA NOT FILED"
  1.  Q
  1.  ;
  1. INITXTMP(NAMESPC,TITLE,LIFE)  ; -- Initialize ^XTMP according to SAC standards.
  1.  N BEGDT,PURGDT
  1.  S BEGDT=$$NOW^XLFDT()
  1.  S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
  1.  S NAMESPC=NAMESPC_"-"_BEGDT_"-"_$J
  1.  S ^XTMP(NAMESPC,0)=PURGDT_"^"_BEGDT_"^"_TITLE
  1.  Q NAMESPC
  1.  ;
  1. TMPMSG  ; Send MailMan LOG REPORT
  1.  N CNT,OBJ,PHANDLE,XMSUB,XMDUZ,PSOCNT,PSODASH,EXREAS,PSOXMD,PSOLDXMD
  1.  S $P(PSODASH,"-",80)=""
  1.  S PHANDLE=$O(^XTMP("PSODEAWB"_"-"_($H+1)),-1)
  1.  S PSOXMD=$$INITXTMP("PSOXMD","DEA INITIAL IMPORT",$S($G(LIFE):LIFE,1:90))
  1.  S PSOLDXMD=$O(^XTMP("PSOXMD")) I PSOLDXMD["PSOXMD" K ^XTMP(PSOLDXMD)
  1.  S XMSUB="DEA Migration Exception Report "_$$FMTE^XLFDT(DT,"5DZ"),XMDUZ=.5
  1.  K XMY S NPIEN=0 F  S NPIEN=$O(^XUSEC("PSDMGR",NPIEN)) Q:'+NPIEN  S XMY(NPIEN)=""
  1.  K PSOTEXT  S PSOCNT=0
  1.  N DEAWORK
  1.  F CNT=1:1:$G(^XTMP(PHANDLE,0,0)) D
  1.  . K OBJ M OBJ=^XTMP(PHANDLE,CNT)
  1.  . I CNT>1,($G(DEAWORK)=OBJ("LOCAL","DEA#")) D  Q   ; Create DEA grouping for multiple exceptions on one DEA number
  1.  . . S EXREAS=$$LJ^XLFSTR(OBJ("Exception"),"138T")
  1.  . . N EXREAS1 S EXREAS1=$E(EXREAS,1,68) S EXREAS1=$P(EXREAS1," ",1,$L(EXREAS1," ")-1)
  1.  . . S PSOCNT=PSOCNT+1,^XTMP(PSOXMD,$J,PSOCNT,0)="EXCEPTION: "_$E(EXREAS,1,$L(EXREAS1))    ; 79
  1.  . . I $TR($E(EXREAS,$L(EXREAS1)+1,999)," ","")'="" S PSOCNT=PSOCNT+1,PSOTEXT(PSOCNT)=$E(EXREAS,$L(EXREAS1)+1,150)
  1.  . . S PSOCNT=$G(PSOCNT)+1
  1.  . ;
  1.  . S ^XTMP(PSOXMD,$J,PSOCNT,0)=PSODASH
  1.  . S PSOCNT=PSOCNT+1
  1.  . S ^XTMP(PSOXMD,$J,PSOCNT,0)="PROVIDER NAME: "_$$LJ^XLFSTR(OBJ("LOCAL","NAME"),"35T")_"  "                 ; 52
  1.  . S ^XTMP(PSOXMD,$J,PSOCNT,0)=^XTMP(PSOXMD,$J,PSOCNT,0)_"INITIALS: "_$$LJ^XLFSTR(OBJ("LOCAL","INITIAL"),"5T")_" "     ; 16
  1.  . ;
  1.  . If OBJ("LOCAL","NAME")'=$G(OBJ("WS","name")) D
  1.  .. S PSOCNT=PSOCNT+1
  1.  .. S ^XTMP(PSOXMD,$J,PSOCNT,0)="DOJ PROVIDER NAME: "_$$LJ^XLFSTR($G(OBJ("WS","name")),"35T")                ; 54
  1.  . ;
  1.  . S PSOCNT=PSOCNT+1
  1.  . S ^XTMP(PSOXMD,$J,PSOCNT,0)="TITLE: "_$$LJ^XLFSTR(OBJ("LOCAL","TITLE"),"30T")_"               "           ; 39
  1.  . S ^XTMP(PSOXMD,$J,PSOCNT,0)=^XTMP(PSOXMD,$J,PSOCNT,0)_"DUZ: "_$$LJ^XLFSTR(OBJ("LOCAL","DUZ"),"10T")                 ; 15
  1.  . ;
  1.  . S PSOCNT=PSOCNT+1
  1.  . S ^XTMP(PSOXMD,$J,PSOCNT,0)="NPI: "_$$LJ^XLFSTR(OBJ("LOCAL","NPI"),"10T")_"           "                   ; 27
  1.  . S ^XTMP(PSOXMD,$J,PSOCNT,0)=^XTMP(PSOXMD,$J,PSOCNT,0)_"DEA#: "_$$LJ^XLFSTR(OBJ("LOCAL","DEA#"),"10T")_"          "  ; 27
  1.  . S ^XTMP(PSOXMD,$J,PSOCNT,0)=^XTMP(PSOXMD,$J,PSOCNT,0)_"MAIL CODE: "_$$LJ^XLFSTR(OBJ("LOCAL","MAIL CODE"),"10T")     ; 21
  1.  . ;
  1.  . S PSOCNT=PSOCNT+1,^XTMP(PSOXMD,$J,PSOCNT,0)="REMARKS: "_$$LJ^XLFSTR(OBJ("LOCAL","REMARKS"),"60T")         ; 69
  1.  . ;
  1.  . S EXREAS=$$LJ^XLFSTR(OBJ("Exception"),"138T")
  1.  . N EXREAS1 S EXREAS1=$E(EXREAS,1,68) S EXREAS1=$P(EXREAS1," ",1,$L(EXREAS1," ")-1)
  1.  . S PSOCNT=PSOCNT+1,^XTMP(PSOXMD,$J,PSOCNT,0)="EXCEPTION: "_$E(EXREAS,1,$L(EXREAS1))    ; 79
  1.  . I $TR($E(EXREAS,$L(EXREAS1)+1,999)," ","")'="" S PSOCNT=PSOCNT+1,^XTMP(PSOXMD,$J,PSOCNT,0)=$E(EXREAS,$L(EXREAS1)+1,150)
  1.  . ;
  1.  . S PSOCNT=PSOCNT+1     ;,^XTMP(PSOXMD,$J,PSOCNT,0)=PSODASH
  1.  . S DEAWORK=OBJ("LOCAL","DEA#")
  1.  . ;
  1.  S PSOCNT=PSOCNT+1
  1.  S ^XTMP(PSOXMD,$J,PSOCNT,0)=PSODASH
  1.  S XMY(DUZ)="" N DIFROM S XMTEXT="^XTMP("""_PSOXMD_""","_$J_"," D ^XMD K DIFROM
  1.  K PSOTEXT,XMTEXT
  1.  ;
  1.  Q