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

RORP024.m

Go to the documentation of this file. 
  1. RORP024 ;ALB/TK  ENV CK, PRE and POST INSTALL - PATCH 24 ;20 Jun 2014  8:21 AM
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**24**;Feb 17, 2006;Build 15
  1.  ;
  1.  ;*****************************************************************************
  1.  ;*****************************************************************************
  1.  ;                       --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE       DEVELOPER    MODIFICATION
  1.  ;-----------  ---------  -----------  ----------------------------------------
  1.  ;ROR*1.5*24   JUN 2014   T KOPP       Added routine for env check, pre/post
  1.  ;                                     install
  1.  ;                                               
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ; 
  1.  ; SUPPORTED CALLS:
  1.  ;  RTN^%ZTLOAD   #10063
  1.  ;  STAT^%ZTLOAD  #10063
  1.  ;  BMES^XPDUTL   #10141
  1.  ;  MES^XPDUTL    #10141
  1.  ;  BLD^DIALOG    #2050
  1.  ;  UPDATE^DIE    #2053
  1.  ;  FILE^DIE      #2053
  1.  ;  FIND1^DIC     #2051
  1.  ;  CODEABA^CODEX #5747
  1.  ;  OBA^ICDEX     #5747
  1.  ;  FMADD^XLFDT   #10103
  1.  ;  NOW^XLFDT     #10103
  1.  ;
  1. ENV ;  Environment check
  1.  S XPDNOQUE=1 ; disable queuing
  1.  Q
  1.  ;
  1. PRE ; Patch pre-install
  1.  N RC,ZTSK,RORBUF,RORMES
  1.  ; Check for ROR INITIALIZE task running
  1.  D BMES^XPDUTL("   *** Checking to be sure ROR INITIALIZE task is not already running")
  1.  S RC=0
  1.  D RTN^%ZTLOAD("RORSET02","RORBUF")
  1.  S ZTSK="" F  S ZTSK=$O(RORBUF(ZTSK)) Q:ZTSK=""  D  I $G(ZTSK(1))=2 S RC=-1 Q
  1.  . D STAT^%ZTLOAD
  1.  ;--- Display error message if option is running
  1.  I RC<0  D  S XPDABORT=2 Q
  1.  . K RORMES
  1.  . D BMES^XPDUTL($$MSG^RORERR20(RC,,XPDNM))
  1.  . D BMES^XPDUTL("")
  1.  . S RORMES(1)="   >> ROR INITIALIZE task is already running.  Task # is "_ZTSK
  1.  . S RORMES(2)="      This task must complete or be terminated before the install can continue"
  1.  . S RORMES(3)="      Restart this patch install when this task is not running"
  1.  . D MES^XPDUTL(.RORMES)
  1.  . ;
  1.  D BMES^XPDUTL("   *** Verifying VA HEPC registry exists on your system")
  1.  S RORIEN=$$FIND1^DIC(798.1,,"X","VA HEPC",,,"RORZMSG")
  1.  I 'RORIEN D  S XPDABORT=2 Q
  1.  . K RORMES
  1.  . S RORMES(1)="   >> Your VA HEPC registry entry cannot be found"
  1.  . S RORMES(2)="      Please correct the entry in the ROR REGISTRY PARAMETERS file and restart this install"
  1.  . S RORMES(3)="      Install was NOT successful!!!!"
  1.  . D MES^XPDUTL(.RORMES)
  1.  Q
  1.  ;
  1. POST ; Patch post-install
  1.  N CT,RORI,RORREG,REGIEN,Z
  1.  D BMES^XPDUTL("POST INSTALL START")
  1.  ;
  1.  D BMES^XPDUTL(">> Adding new report to the VA HEPC registry parameters")
  1.  D AVRPT
  1.  D BMES^XPDUTL("   >> Step complete")
  1.  ;
  1.  D BMES^XPDUTL(">> Adding new LOINC codes to the VA HEPC and VA HIV registry parameters")
  1.  D LOINC
  1.  D BMES^XPDUTL("   >> Step complete")
  1.  ;
  1.  D BMES^XPDUTL(">> Adding new registry entries to ROR ICD SEARCH with appropriate diagnosis codes")
  1.  D ADDICD
  1.  D BMES^XPDUTL("   >> Step complete")
  1.  ;
  1.  D BMES^XPDUTL(">> Initiating background job to set up registries added with this patch")
  1.  N RORKIDS
  1.  S RORKIDS=1
  1.  F RORI=1:1 S RORREG=$P($P($T(@("REGCODES+"_RORI_"^RORP024")),";;",2),U) Q:RORREG=""  D
  1.  . S REGIEN=$$REGIEN^RORUTL02(RORREG)
  1.  . I REGIEN>0 D
  1.  .. K RORFDA,RORMSG,RORERR,DIERR
  1.  .. S RORFDA(798.1,REGIEN_",",1)=2850101
  1.  .. S RORFDA(798.1,REGIEN_",",21.05)=""
  1.  .. S RORFDA(798.1,REGIEN_",",19.1)=""
  1.  .. D UPDATE^DIE(,"RORFDA",,"RORMSG")
  1.  .. I $G(DIERR) D
  1.  ... D DBS^RORERR("RORMSG",-112,,,798.1,REGIEN)
  1.  ... K RORERR
  1.  ... S RORERR(1)="     New registry "_RORREG_"(ien #"_REGIEN_") encountered the following error"
  1.  ... S RORERR(2)="     and may not initialize correctly.  Please report this error to your CCR contact:"
  1.  ... S RORERR(3)=""
  1.  ... S Z=0,CT=3 F  S Z=$O(RORMSG("DIERR",1,"TEXT",Z)) Q:'Z  S CT=CT+1,RORERR(CT)=$J("",10)_$G(RORMSG("DIERR",1,"TEXT",1))
  1.  ... D MES^XPDUTL(.RORERR)
  1.  D ^RORSET02
  1.  D BMES^XPDUTL("   >> Step complete")
  1.  ;
  1.  D BMES^XPDUTL("POST INSTALL COMPLETE")
  1.  Q
  1.  ;
  1. AVRPT ;  Update available reports in VA HEPC registry
  1.  N RORFDA,RORIEN,RORZMSG,X,Y
  1.  K RORZMSG
  1.  S RORIEN=$$FIND1^DIC(798.1,,"X","VA HEPC",,,"RORZMSG")
  1.  S RORIEN=+RORIEN_","
  1.  S RORFDA(798.1,RORIEN,27)="1,2,3,4,5,6,7,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23"
  1.  K RORZMSG
  1.  I RORIEN>0 D FILE^DIE(,"RORFDA","RORZMSG")
  1.  Q
  1.  ;
  1. LOINC ;Add new LOINC codes to the VA HEPC and VA HIV lab search criterion in
  1.  ;ROR LAB SEARCH file #798.9.  Don't add them if they already exist.  Don't
  1.  ;add the 'dash' or the number following it (checksum)
  1.  ;**********************************************************************
  1.  N I,HEPCIEN,HIVIEN,RORDATA,RORLOINC,RORTAG,ROR K RORMSG1,RORMSG2
  1.  S HIVIEN=$O(^ROR(798.9,"B","VA HIV",0)) ;HIV top level IEN
  1.  S HEPCIEN=$O(^ROR(798.9,"B","VA HEPC",0)) ;HEPC top level IEN
  1.  ;--- add LOINC codes to the VA HIV search criteria
  1.  F I=1:1  S RORTAG="HIV+"_I,ROR=$P($T(@RORTAG),";;",2) Q:ROR=""  D
  1.  . S RORLOINC=$P(ROR,"-",1)
  1.  . ;don't add if it's already in the global
  1.  . Q:($D(^ROR(798.9,HIVIEN,1,"B",RORLOINC)))
  1.  . S RORDATA(1,798.92,"+2,"_HIVIEN_",",.01)=$G(RORLOINC)
  1.  . S RORDATA(1,798.92,"+2,"_HIVIEN_",",1)=6
  1.  . D UPDATE^DIE("","RORDATA(1)",,"RORMSG1")
  1.  K RORDATA(1)
  1.  ;--- add LOINC codes to the VA HEPC search criteria
  1.  F I=1:1:5  S RORTAG="HEP+"_I,ROR=$P($T(@RORTAG),";;",2) Q:ROR=""  D
  1.  . S RORLOINC=$P(ROR,"-",1)
  1.  . ;don't add if it's already in the global
  1.  . Q:($D(^ROR(798.9,HEPCIEN,1,"B",RORLOINC)))
  1.  . S RORDATA(1,798.92,"+2,"_HEPCIEN_",",.01)=$G(RORLOINC)
  1.  . S RORDATA(1,798.92,"+2,"_HEPCIEN_",",1)=6
  1.  . D UPDATE^DIE("","RORDATA(1)",,"RORMSG2")
  1.  K RORDATA,RORMSG1,RORMSG2
  1.  ;
  1.  Q
  1.  ;
  1.  ;**********************************************************************
  1.  ;New LOINC codes
  1.  ;**********************************************************************
  1. HIV ;
  1.  ;;35438-1
  1.  ;;41143-9
  1.  ;;43599-0
  1.  ;;48345-3
  1.  ;;48346-1
  1.  ;;49483-1
  1.  ;;5220-9
  1.  ;;57975-5
  1.  ;;68961-2
  1.  ;;69668-2
  1.  ;;73905-2
  1.  ;;73906-0
  1.  ;;16976-3
  1.  ;;18396-2
  1.  ;;24012-7
  1.  ;;33660-2
  1.  ;;42339-2
  1.  ;;44531-2
  1.  ;;44872-0
  1.  ;;5222-5
  1.  ;;53601-1
  1.  ;;9665-1
  1.  ;;9821-0
  1.  ;;
  1.  ;
  1. HEPC ;
  1.  ;;39008-8
  1.  ;;51657-5
  1.  ;;72376-7
  1.  ;;
  1.  ;
  1.  ; Data set up for REGCODES is 
  1.  ;   ^ piece 1: name of registry
  1.  ;   ^ piece 2: ICD code if ICD-9 or ICD code followed by ~30 if ICD-10.  Multiple codes are separated by comma.
  1. REGCODES ; New registry add ICD9 and ICD10 diagnosis codes with wild card denoted by % to be added to ROR ICD SEARCH file
  1.  ;;VA OSTEOPOROSIS^733.00,733.01,733.02,733.03,733.09,M80.%~30,M81.%~30
  1.  ;;VA ALS^335.20,G12.21~30
  1.  ;;VA HCC^155.0,C22.0~30
  1.  ;;VA LUNG CANCER^162.2,162.3,162.4,162.5,162.8,162.9,231.2,V10.11,C34.%~30
  1.  ;;VA MELANOMA^172.0,172.1,172.2,172.3,172.4,172.5,172.6,172.7,172.8,172.9,C43.%~30
  1.  ;;VA COLORECTAL CANCER^153.0,153.1,153.2,153.3,153.4,153.5,153.6,153.7,153.8,153.9,154.0,154.1,230.3,230.4,V10.05,V10.06,C18.%~30,C19.~30,C20.~30
  1.  ;;VA PANCREATIC CANCER^157.0,157.1,157.2,157.3,157.4,157.8,157.9,C25.%~30
  1.  ;;VA PROSTATE CANCER^185.,233.4,V10.46,C61.~30
  1.  ;;
  1.  ;
  1. ADDICD ; Add registry and specific/wild card-specified ICD codes to the ROR ICD SEARCH file
  1.  N RORX,RORZ
  1.  F RORZ=1:1 S RORX=$P($T(REGCODES+RORZ),";;",2) Q:RORX=""  D
  1.  . N DA,DIC,DIERR,RORREG,RORREG1,RORIEN,RORINFO,RORREGNM,RORLIST,RORCDX,RORICD,RORX1,RORYY,RORWCARD,RORFILE,X,Y
  1.  . S RORREGNM=$P(RORX,U),RORLIST=$P(RORX,U,2)
  1.  . S RORREG1=$$FIND1^DIC(798.1,"","X",RORREGNM)
  1.  . Q:'RORREG1
  1.  . K RORDATA,RORIEN
  1.  . S RORDATA(1,798.5,"?+1,",.01)=RORREG1
  1.  . S RORIEN(1)=RORREG1 ; Make ien the same as file 798.1
  1.  . D UPDATE^DIE("","RORDATA(1)","RORIEN")
  1.  . Q:$G(DIERR)  ; Lookup or addition unsuccessful
  1.  . S RORREG=RORREG1
  1.  . F RORYY=1:1 S RORINFO=$P(RORLIST,",",RORYY),RORCDX=$P($P(RORINFO,"~"),"%"),RORFILE=+$P(RORINFO,"~",2) Q:RORCDX=""  D
  1.  .. S RORX1=RORCDX,RORWCARD=$S(RORINFO["%":1,1:0) S:'RORFILE RORFILE=1
  1.  .. S RORICD=+$$CODEABA^ICDEX(RORX1,"",RORFILE) ; Code lookup in file 80
  1.  .. I RORICD'>0 Q:'RORWCARD  ; Code not found and not a wildcard
  1.  .. I RORICD>0 D FILEICD(RORREG,RORICD) ; Single code or 'base' code of wildcard sequence
  1.  .. Q:'RORWCARD
  1.  .. ; Use wild card to find matching code entries
  1.  .. F  S RORX1=$$OBA^ICDEX(80,RORX1) Q:$S(RORX1="":1,1:$E(RORX1,1,$L(RORCDX))'=RORCDX)  D
  1.  ... S RORICD=+$$CODEABA^ICDEX(RORX1,"",RORFILE)
  1.  ... Q:RORICD'>0
  1.  ... D FILEICD(RORREG,RORICD)
  1.  Q
  1.  ;
  1.  ; RORREG = ien of registry
  1.  ; RORICD = ien of diagnosis code to add to registry
  1. FILEICD(RORREG,RORICD) ; Add ICD code to ROR ICD SEARCH file
  1.  N RORICD1,RORDATA
  1.  ; Don't add if it already exists for the registry
  1.  S RORICD1=$$FIND1^DIC(798.51,","_RORREG_",","Q",RORICD,"B")
  1.  Q:RORICD1'=0  ;quit if code is already assigned to rule 
  1.  K RORDATA
  1.  S RORDATA(1,798.51,"+2,"_RORREG_",",.01)=RORICD
  1.  D UPDATE^DIE("","RORDATA(1)")
  1.  Q
  1.  ;
  1.  ; Sets the DIR array from the post-install question #3 (suspension start time)
  1. POSQ3(DIR) ;
  1.  K:$G(XPDQUES("POSQ2"))'=1 DIR
  1.  Q:'$D(DIR)
  1.  D BLD^DIALOG(7980000.011,,,"DIR(""?"")","S")
  1.  Q
  1.  ;
  1.  ; Sets the DIR array from the post-install question #4  (suspension end time)
  1. POSQ4(DIR) ;
  1.  K:$G(XPDQUES("POSQ2"))'=1 DIR
  1.  Q:'$D(DIR)
  1.  S DIR("A")="Suspension end time"
  1.  ;  Make sure end time entered is later than end time start
  1.  S DIR(0)="D^::R^K:(Y#1)'>(XPDQUES(""POSQ3"")#1) X"
  1.  D BLD^DIALOG(7980000.012,,,"DIR(""?"")","S")
  1.  Q
  1.  ;
  1.  ; Updates the DIR array from the post-install question #5  (schedule time for ROR INITIALIZE task)
  1. POSQ5(DIR) ;
  1.  Q:'$D(DIR)
  1.  N ROREDT
  1.  ; Set earliest date to schedule to 15 minutes from 'NOW'
  1.  S ROREDT=$$FMADD^XLFDT($$NOW^XLFDT(),,,15)
  1.  ; Strip seconds
  1.  S ROREDT=$P(ROREDT,".",1)_"."_$E($P(ROREDT,".",2),1,4)
  1.  ;  Make sure future date/time is entered
  1.  S $P(DIR(0),U,3)=("K:Y<"_ROREDT_" X")
  1.  S DIR("B")=$$FMTE^XLFDT(ROREDT,2)
  1.  Q
  1.  ;