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

PSO7P684.m

Go to the documentation of this file. 
  1. PSO7P684 ;WILM/BDB - Pre Install routine for patch PSO*7*684 ;4/22/2022
  1.  ;;7.0;OUTPATIENT PHARMACY;**684,545,731**;DEC 1997;Build 18
  1.  Q
  1.  ;
  1. PRE ; Pre-Install Entry Point
  1.  N HANDPSO S HANDPSO="PSO70684-INSTALL"
  1.  ;
  1.  I '$D(ZTQUEUED) D  Q
  1.  .N PSOASTER S $P(PSOASTER,"*",74)="*"
  1.  .S XPDABORT=1
  1.  .D BMES^XPDUTL(PSOASTER)
  1.  .D MES^XPDUTL("  Patch Install must be Queued. Please unload this distribution")
  1.  .D MES^XPDUTL("   and run install again with Queueing.")
  1.  .D MES^XPDUTL(PSOASTER)
  1.  ;
  1.  L +^XTMP(HANDPSO):0 I '$T D  Q
  1.  . S XPDABORT=1
  1.  . D BMES^XPDUTL("PSO*7*684 DEA Migration job is already running.  Halting...")
  1.  . D MES^XPDUTL("")
  1.  ;
  1.  ;The doj/dea file should NOT be loaded in prod if PSO*7*545 installed more than 7 days ago
  1.  I $$PROD^XUPROD,$$P545CHK7^PSO7E684() L -^XTMP(HANDPSO) Q
  1.  ;
  1.  ;check if the doj/dea file should be loaded based on the install question
  1.  I '$$PROD^XUPROD(),($G(XPDQUES("PRE1","B"))["N") D  Q
  1.  . S ^XTMP(HANDPSO,"STATUS")="Install Completed"
  1.  . L -^XTMP(HANDPSO)
  1.  ;
  1.  S ^XTMP(HANDPSO,"STATUS")="In Progress"
  1.  ;
  1.  ;delete the new DEA data in files #200 and #8991.9
  1.  N DEA,NPIEN,DA,DEAIEN
  1.  D BMES^XPDUTL("******")
  1.  D MES^XPDUTL("Deleting the DEA profile data for the DEA multiple fields in the")
  1.  D MES^XPDUTL("New Person file (#200) and in the DEA Numbers file (#8991.9).")
  1.  D MES^XPDUTL("Performing the DOJ DEA migration.")
  1.  D MES^XPDUTL("******")
  1.  S DEA="A"
  1.  F  S DEA=$O(^VA(200,"PS4",DEA)) Q:DEA=""  D 
  1.  .S NPIEN=0 S NPIEN=$O(^VA(200,"PS4",DEA,NPIEN)) Q:NPIEN=""  D
  1.  ..S DA=$O(^VA(200,"PS4",DEA,NPIEN,0)) Q:DA=""
  1.  ..S DA(1)=NPIEN,DIK="^VA(200,"_DA(1)_",""PS4""," D ^DIK K DIK
  1.  S DEAIEN=0 F  S DEAIEN=$O(^XTV(8991.9,DEAIEN)) Q:DEAIEN=""  D
  1.  .S DA=DEAIEN,DIK="^XTV(8991.9," D ^DIK K DIK,DA
  1.  ;run the initial load of the DOJ DEA data
  1.  ;
  1.  D INITLOAD(90)
  1.  S ^XTMP(HANDPSO,"STATUS")="Install Completed"
  1.  L -^XTMP(HANDPSO)
  1.  ;
  1.  Q
  1.  ;
  1. INITLOAD(LIFE) ; -- main entry point for DEA INITIAL IMPORT
  1.  N DEA,FG,NPIEN,NPDATA,NPNAME,DEAIEN,PHANDLE,PSOLDHNDL,HANDPSO,MIGRCNT,EXCNT
  1.  S HANDPSO="PSO70684-INSTALL"
  1.  S MIGRCNT=0,EXCNT=0
  1.  S PSOLDHNDL=$O(^XTMP("PSODEAWB-")) I PSOLDHNDL["PSODEAWB" K ^XTMP(PSOLDHNDL) ; Remove oldest 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.  . S NPIEN=0 F  S NPIEN=$O(^VA(200,"PS1",DEA,NPIEN)) Q:'NPIEN  D
  1.  .. N FILERR,ERRCODE,FG
  1.  .. S NPNAME=$$GET1^DIQ(200,NPIEN,.01)
  1.  .. I NPNAME']"" D  Q
  1.  ... N PSOASTER
  1.  ... S $P(PSOASTER,"*",74)="*"
  1.  ... D BMES^XPDUTL(PSOASTER)
  1.  ... D BMES^XPDUTL("Database error for the New Person file #200.")
  1.  ... D BMES^XPDUTL("DEA Number "_DEA_",   IEN= "_NPIEN)
  1.  ... D BMES^XPDUTL(PSOASTER)
  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",DEA,.EXCNT) Q
  1.  .. I 'SC I $G(ERRCODE)[404 D LOG(.FG,NPIEN,PHANDLE,"DEA# NOT FOUND IN DOJ FILE",DEA,.EXCNT) Q
  1.  .. I $P(FG("name"),",",1)'=$P(NPNAME,",",1) D LOG(.FG,NPIEN,PHANDLE,"NAME MISMATCH",DEA,.EXCNT) Q
  1.  .. I ($E($G(FG("businessActivityCode")))'="")&($E($G(FG("businessActivityCode")))'="M")&($E($G(FG("businessActivityCode")))'="C") D LOG(.FG,NPIEN,PHANDLE,"INSTITUTIONAL DEA# REQUIRES INDIVIDUAL DEA SUFFIX",DEA,.EXCNT) Q
  1.  .. I $D(^XTV(8991.9,"B",DEA)) D LOG(.FG,NPIEN,PHANDLE,"DUPLICATE DEA NUMBER",DEA,.EXCNT) Q
  1.  .. K DEAIEN S SC=$$DEAFILE(DEA,NPIEN,PHANDLE,.FG,.DEAIEN,.EXCNT) I 'SC  D LOG(.FG,NPIEN,PHANDLE,"DATA FILING ISSUE. "_$P($G(SC),"^",2),DEA,.EXCNT) Q
  1.  .. D NPFILE(DEA,NPIEN,DEAIEN,.FILERR) D  Q
  1.  ... I $G(FILERR)'="" D LOG(.FG,NPIEN,PHANDLE,"MIGRATION DATA NOT FILED. "_FILERR,DEA,.EXCNT) Q
  1.  ... S MIGRCNT=$G(MIGRCNT)+1
  1.  K ^TMP($J,"PSODEAWB")
  1.  D TMPMSG(EXCNT,MIGRCNT,LIFE)
  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,DEA,EXCNT) ; -- Log import issues
  1.  N CNT,FLD,IENS,TR
  1.  ;
  1.  N EXCNUM S EXCNUM=$O(^XTMP(PHANDLE,"PROVIDER",NPIEN,"DEA",DEA,999),-1)+1
  1.  S ^XTMP(PHANDLE,"PROVIDER",NPIEN,"DEA",DEA,EXCNUM)=REASON
  1.  S EXCNT=$G(EXCNT)+1
  1.  ;
  1.  Q
  1.  ;
  1. DEAFILE(DEA,NPIEN,PHANDLE,FG,DEAIEN,EXCNT) ; -- 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.  ;P731 detox/x-waiver removal
  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.",DEA)
  1.  ;I NPDETOX'="",$$DETOXCHK^PSODEAUT(BAC),NPDETOX'=("X"_$E(DEA,2,9)) D LOG(.FG,NPIEN,PHANDLE,"DETOX MISMATCH-LOCAL:'"_NPDETOX_"' CALCULATED:'"_"X"_$E(DEA,2,9)_"'",DEA,.EXCNT)
  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,"DETOX number duplicate "_CMPDETOX_" not filed.",DEA,.EXCNT) 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,"SCHEDULE MISMATCH-LOCAL:'"_$TR(SCH200ST," ")_"' DOJ:'"_$TR(DS," ")_"'",DEA,.EXCNT)
  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,"SCHEDULE MISMATCH-LOCAL:'"_$TR(SCH200ST," ")_"' DOJ:'"_$TR(DS," ")_"'",DEA,.EXCNT)
  1.  ;
  1.  S FDA(1,8991.9,IENS,10.2)="N"  ; LAST UPDATED 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.  S ^XTMP(NAMESPC,"START")=BEGDT
  1.  Q NAMESPC
  1.  ;
  1. TMPMSG(EXCNT,MIGRCNT,LIFE)  ; Send MailMan LOG REPORT
  1.  N CNT,OBJ,PHANDLE,XMSUB,XMDUZ,PSOCNT,PSODASH,EXREAS,PSOXMD,PSOLDXMD,PSOSTART,PSODONE
  1.  S $P(PSODASH,"-",80)=""
  1.  S PHANDLE=$O(^XTMP("PSODEAWB"_"-"_($H+1)),-1)
  1.  S ^XTMP(PHANDLE,"COMPLETE")=$$NOW^XLFDT
  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 Complete "_$$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
  1.  ;
  1.  S PSOSTART=$G(^XTMP(PHANDLE,"START")) I PSOSTART S PSOSTART=$$FMTE^XLFDT(PSOSTART)
  1.  S PSODONE=$G(^XTMP(PHANDLE,"COMPLETE")) I PSODONE S PSODONE=$$FMTE^XLFDT(PSODONE)
  1.  S ^XTMP(PSOXMD,$J,1,0)=$S($L(PSOSTART):"   DEA Migration Started: "_$$FMTE^XLFDT(PSOSTART),1:"")
  1.  S ^XTMP(PSOXMD,$J,2,0)=$S($L(PSODONE):" DEA Migration Completed: "_$$FMTE^XLFDT(PSODONE),1:"")
  1.  S ^XTMP(PSOXMD,$J,3,0)=""
  1.  S ^XTMP(PSOXMD,$J,4,0)=" "_MIGRCNT_" DEA numbers were migrated from the NEW PERSON (#200) file"
  1.  S ^XTMP(PSOXMD,$J,5,0)=" to the DEA NUMBERS (#8991.9) file. "
  1.  S ^XTMP(PSOXMD,$J,6,0)=" "
  1.  S ^XTMP(PSOXMD,$J,7,0)=" "_EXCNT_" exceptions were logged during the DEA migration."
  1.  S ^XTMP(PSOXMD,$J,8,0)=" Use the DEA Migration Report [PSO DEA MIGRATION REPORT] option"
  1.  S ^XTMP(PSOXMD,$J,9,0)=" to view migration and exception details."
  1.  ;
  1.  S XMY(DUZ)="" N DIFROM S XMTEXT="^XTMP("""_PSOXMD_""","_$J_"," D ^XMD K DIFROM
  1.  K PSOTEXT,XMTEXT
  1.  ;
  1.  Q