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

RORUTL06.m

Go to the documentation of this file. 
  1. RORUTL06 ;HCIOFO/SG - DEVELOPER ENTRY POINTS ; 11/20/05 5:09pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !,"CLINICAL CASE REGISTRIES DEVELOPER'S UTILITIES"
  1.  S X=""
  1.  S X=X_";M:Metadata definitions"
  1.  S X=X_";V:Verify registry definition"
  1.  S X=X_";P:Prepare for KIDS"
  1.  S DIR(0)="SO^"_$P(X,";",2,999)
  1.  D ^DIR  W !  Q:$D(DIRUT)
  1.  G PRTMDE:Y="M",VERIFY:Y="V",DISTPREP:Y="P"
  1.  Q
  1.  ;
  1.  ;***** VERIFIES REGISTRY DEFINITION
  1. VERIFY ;
  1.  N RORERRDL      ; Default error location
  1.  N RORERROR      ; Error processing data
  1.  N RORLOG        ; Log parameters
  1.  N RORPARM       ; Application parameters
  1.  ;
  1.  N RC,REGLST,REGNAME,TMP
  1.  W !,"REGISTRY DEFINITION VERIFIER",!
  1.  D KILL^XUSCLEAN,INIT^RORUTL01("ROR")
  1.  S RORPARM("DEBUG")=2
  1.  S RORPARM("ERR")=1
  1.  S RORPARM("LOG")=1
  1.  F TMP=1:1:6  S RORPARM("LOG",TMP)=1
  1.  D CLEAR^RORERR("START^RORUTL06")
  1.  ;--- Select registries
  1.  Q:$$SELREG^RORUTL07(.REGLST)'>0
  1.  ;--- Validate registry update defintion
  1.  S RC=$$UPDDEF(.REGLST)  G:RC<0 ERROR
  1.  ;--- Validate data extraction defintion
  1.  S RC=$$EXTDEF(.REGLST)  G:RC<0 ERROR
  1.  ;--- Cleanup
  1.  D INIT^RORUTL01("ROR")
  1.  Q
  1.  ;
  1.  ;***** PREPARES THE REGISTRY FOR KIDS DISTRIBUTION
  1. DISTPREP ;
  1.  N RORERRDL      ; Default error location
  1.  N RORERROR      ; Error processing data
  1.  N RORFULL       ; Full installation (backpull, population, etc.)
  1.  N RORPARM       ; Application parameters
  1.  ;
  1.  N IENS,FLD,FULL,RC,REGIEN,REGNAME,RORFDA,RORMSG
  1.  N DA,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !,"REGISTRY PREPARATION FOR KIDS DISTRIBUTION",!
  1.  D KILL^XUSCLEAN
  1.  S RORPARM("ERR")=1
  1.  D CLEAR^RORERR("DISTPREP^RORUTL06")
  1.  ;--- Select a registry
  1.  S RC=$$SELREG^RORUTL18(.REGNAME)  G:RC<0 ERROR
  1.  Q:RC'>0  S REGIEN=RC
  1.  ;--- Select the type of distribution
  1.  K DIR  S DIR(0)="S^I:Installation;U:Update",DIR("B")="Update"
  1.  S DIR("A")="Slect the type of distribution"
  1.  D ^DIR  Q:$D(DIRUT)  W !
  1.  S RORFULL=(Y="I")
  1.  ;--- Request a confirmation
  1.  K DIR  S DIR(0)="Y",DIR("B")="NO"
  1.  S DIR("A",1)="Some fields of the '"_REGNAME_"' registry parameters"
  1.  S DIR("A",2)="will be cleared to prepare them for KIDS distribution."
  1.  S DIR("A")="Do you really want to do this"
  1.  D ^DIR  Q:'$G(Y)  W !
  1.  ;--- Clear Registry parameters (single-valued)
  1.  S IENS=REGIEN_","
  1.  F FLD=1,2,5,13,19.1,19.2,19.3,21.01,21.04,21.05  D
  1.  . S RORFDA(798.1,IENS,FLD)="@"
  1.  D FILE^DIE(,"RORFDA","RORMSG")
  1.  G:$$DBS^RORERR("RORMSG",-9,,,798.1,IENS) ERROR
  1.  ;--- Clear Registry parameters (multiples)
  1.  S IENS=","_REGIEN_","
  1.  G:$$CLEAR^RORUTL05(798.11,IENS)<0 ERROR  ; LOG EVENT (8.1)
  1.  G:$$CLEAR^RORUTL05(798.114,IENS)<0 ERROR ; NOTIFICATION (14)
  1.  G:$$CLEAR^RORUTL05(798.122,IENS)<0 ERROR ; LAST BATCH CONTROL ID (22)
  1.  G:$$CLEAR^RORUTL05(798.128,IENS)<0 ERROR ; LOCAL LAB TEST (28)
  1.  G:$$CLEAR^RORUTL05(798.129,IENS)<0 ERROR ; LOCAL DRUG (29)
  1.  G:$$CLEAR^RORUTL05(798.12,IENS)<0 ERROR  ; REPORT STATS (30)
  1.  ;--- Registry-specific data
  1.  I REGNAME="VA HEPC"  G:$$HEPC(REGIEN)<0 ERROR
  1.  I REGNAME="VA HIV"   G:$$HIV(REGIEN)<0 ERROR
  1.  ;--- Clean the ROR LOCAL FIELD file (#799.53)
  1.  G:$$LOCFLDS()<0 ERROR
  1.  ;--- Success
  1.  W !,"Registry parameters are ready for distribution."
  1.  Q
  1.  ;
  1.  ;***** DISPLAYS THE ERRORS
  1. ERROR ;
  1.  D DSPSTK^RORERR()
  1.  Q
  1.  ;
  1.  ;***** VALIDATES DATA EXTRACTION DEFINITION
  1.  ;
  1.  ; .REGLST       Reference to a local array containing
  1.  ;               registry names as subscripts
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error Code
  1.  ;        0  Ok
  1.  ;
  1. EXTDEF(REGLST) ;
  1.  N RORERRDL      ; Default error location
  1.  N ROREXT        ; Data extraction descriptor
  1.  N RORHL         ; HL7 variables
  1.  N RORLRC        ; List of codes of Lab results to be extracted
  1.  ;
  1.  N RC
  1.  W !,"DATA EXTRACTION DEFINITION",!
  1.  D CLEAR^RORERR("UPDDEF^RORUTL06")
  1.  S RC=$$PREPARE^ROREXPR(.REGLST)
  1.  D:RC'<0 DEBUG^ROREXTUT
  1.  Q RC
  1.  ;
  1.  ;***** HEPC-SPECIFIC PREPARATIONS
  1. HEPC(REGIEN) ;
  1.  N IENS,RORFDA,RORMSG
  1.  S IENS=(+REGIEN)_","
  1.  D:$G(RORFULL)
  1.  . S RORFDA(798.1,IENS,1)=2900101  ; REGISTRY UPDATED UNTIL
  1.  . S RORFDA(798.1,IENS,2)=2850101  ; DATA EXTRACTED UNTIL
  1.  S RORFDA(798.1,IENS,25)=1         ; ENABLE PROTOCOLS
  1.  D FILE^DIE(,"RORFDA","RORMSG")
  1.  Q $$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
  1.  ;
  1.  ;***** HIV-SPECIFIC PREPARATIONS
  1. HIV(REGIEN) ;
  1.  N IENS,RORFDA,RORMSG
  1.  S IENS=(+REGIEN)_","
  1.  D:$G(RORFULL)
  1.  . S RORFDA(798.1,IENS,1)=2850101  ; REGISTRY UPDATED UNTIL
  1.  . S RORFDA(798.1,IENS,2)=2850101  ; DATA EXTRACTED UNTIL
  1.  S RORFDA(798.1,IENS,25)=1         ; ENABLE PROTOCOLS
  1.  D FILE^DIE(,"RORFDA","RORMSG")
  1.  Q $$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
  1.  ;
  1.  ;***** CLEANS THE 'ROR LOCAL FIELD' FILE (#799.53)
  1. LOCFLDS() ;
  1.  N DA,DIK,ROOT
  1.  S DIK=$$ROOT^DILFD(799.53),ROOT=$$CREF^DILF(DIK)
  1.  S DA=0
  1.  F  S DA=$O(@ROOT@(DA))  Q:DA'>0  D ^DIK
  1.  Q 0
  1.  ;
  1.  ;***** PRINTS THE DATA ELEMENT METADATA
  1. PRTMDE ;
  1.  N RORCOLS       ; Lits of column descriptors
  1.  N RORERRDL      ; Default error location
  1.  N RORERROR      ; Error processing data
  1.  N RORLST        ; List of files grouped by parents
  1.  N RORPAGE       ; Current page number
  1.  N RORPARM       ; Application parameters
  1.  N RORTTL        ; Title of the report
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,MODE,TMP,X,Y
  1.  D KILL^XUSCLEAN
  1.  S (DDBDMSG,RORTTL)="METADATA OF THE DATA ELEMENTS"
  1.  W !,RORTTL,!  S RORPARM("ERR")=1
  1.  D CLEAR^RORERR("PRTMDE^RORUTL06")
  1.  ;---Request report sort mode from user
  1.  S DIR(0)="S^H:Hierarhical;L:List of codes"
  1.  S DIR("A")="Sort mode",DIR("B")="List of codes"
  1.  D ^DIR  Q:$D(DIRUT)  S MODE=Y
  1.  ;--- Generate and print the report
  1.  I MODE="H"  S RC=0  D
  1.  . N %ZIS,I,FILE,PARENT,ROOT,RORMSG
  1.  . S ROOT=$$ROOT^DILFD(799.2,,1),RORPAGE=0
  1.  . ;--- Load column descriptors
  1.  . F I=1:1  S TMP=$P($T(PRTMDEH+I),";;",2)  Q:TMP=""  D
  1.  . . S RORCOLS(I)=$TR($P(TMP,U,1,3)," ")_U_$P(TMP,U,4)
  1.  . ;--- Load file list
  1.  . S FILE=0,RC=0
  1.  . F  S FILE=$O(@ROOT@(FILE))  Q:FILE'>0  D  Q:RC<0
  1.  . . S PARENT=+$$GET1^DIQ(799.2,FILE_",",1,"I",,"RORMSG")
  1.  . . I $G(DIERR)  D  Q
  1.  . . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.2,FILE_",")
  1.  . . S RORLST(PARENT,FILE)=""
  1.  . Q:RC<0
  1.  . ;--- Print the report
  1.  . S %ZIS("B")=""
  1.  . D ^%ZIS   Q:$G(POP)  U IO
  1.  . S RC=$$PRTMDEH()  S:RC'<0 RC=$$PRTMDE1(0,1)
  1.  . D ^%ZISC
  1.  E  S RC=$$PRTMDE2()
  1.  G:RC<0 ERROR
  1.  Q
  1.  ;
  1.  ;***** PRINTS A LEVEL OF THE "FILE-PROCESSING TREE"
  1.  ;
  1.  ; PARENT        Parent file number
  1.  ; LEVEL         Number of the current level in the tree
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error Code
  1.  ;        0  Ok
  1.  ;
  1. PRTMDE1(PARENT,LEVEL) ;
  1.  N FIELDS,FILE,FLD,I,IENS,IR,L,RORBUF,RORMSG
  1.  S FIELDS="@;.01E;.02I;1I;2E;4I;4.1;4.2;6I"
  1.  ;---
  1.  S FILE="",RC=0
  1.  F  S FILE=$O(RORLST(PARENT,FILE))  Q:FILE=""  D  Q:RC<0
  1.  . ;--- Load descriptors of the data elements
  1.  . K RORBUF  S IENS=","_FILE_","
  1.  . D LIST^DIC(799.22,IENS,FIELDS,,,,,"B",,,"RORBUF","RORMSG")
  1.  . ;--- Print header (if necessary) and file number
  1.  . I ($Y+5)>IOSL  S RC=$$PRTMDEH()  Q:RC<0
  1.  . D PRTMDEL(LEVEL-1),PRTMDEL(LEVEL-1,FILE)
  1.  . ;--- Print data element descriptors
  1.  . S IR="",RC=0
  1.  . F  S IR=$O(RORBUF("DILIST","ID",IR))  Q:IR=""  D  Q:RC<0  W !
  1.  . . I ($Y+5)>IOSL  S RC=$$PRTMDEH()  Q:RC<0
  1.  . . D:IR>1 PRTMDEL(LEVEL,"")
  1.  . . S I=""
  1.  . . F  S I=$O(RORCOLS(I))  Q:I=""  D
  1.  . . . S FLD=+$P(RORCOLS(I),U,2)  Q:FLD'>0
  1.  . . . S L=+$P(RORCOLS(I),U,3)  S:L'>0 L=999
  1.  . . . W ?(+RORCOLS(I)),$E($G(RORBUF("DILIST","ID",IR,FLD)),1,L)
  1.  . Q:RC<0
  1.  . S:$D(RORLST(FILE))>1 RC=$$PRTMDE1(FILE,LEVEL+1)
  1.  Q $S(RC<0:RC,1:0)
  1.  ;
  1.  ;***** PRINTS A TABLE OF DATA ELEMENTS
  1. PRTMDE2() ;
  1.  N BY,DHD,FR,L,DIC,FLDS,TO
  1.  S L=0,DIC=799.2,DHD=RORTTL
  1.  S BY="[ROR DATA ELEMENTS]",FLDS="[ROR DATA ELEMENTS]"
  1.  D EN1^DIP
  1.  Q 0
  1.  ;
  1.  ;***** PRINTS A HEADER OF THE DATA ELEMENT REPORT
  1.  ;  X  Field Width Title
  1. PRTMDEH() ;
  1.  ;;  0^     ^     ^File
  1.  ;; 22^  .01^   25^Data Name
  1.  ;; 49^  .02^     ^Code
  1.  ;; 55^ 2   ^     ^Req
  1.  ;; 60^ 1   ^     ^API
  1.  ;; 65^ 6   ^     ^Field Number
  1.  ;; 82^ 4   ^     ^VT
  1.  ;; 86^ 4.1 ^   20^External
  1.  ;;108^ 4.2 ^   20^Internal
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,I,X,Y
  1.  I RORPAGE,$E(IOST,1,2)="C-"  D  Q:'Y $S(Y="":-72,1:-71)
  1.  . S DIR(0)="E"  D ^DIR
  1.  W:RORPAGE!($E(IOST,1,2)="C-") @IOF
  1.  S RORPAGE=RORPAGE+1,I=""  W RORTTL,!
  1.  F  S I=$O(RORCOLS(I))  Q:I=""  W ?(+RORCOLS(I)),$P(RORCOLS(I),U,4)
  1.  S X="",$P(X,"-",IOM)=""
  1.  W !,X,!
  1.  Q 0
  1.  ;
  1.  ;***** PRINTS THE LEVEL INDICATOR
  1.  ;
  1.  ; N             Number of dots in the indicator
  1.  ; [FILE]        File number
  1.  ;
  1. PRTMDEL(N,FILE) ;
  1.  N I  W:$X>0 !  F I=1:1:N  W ". "
  1.  W:$D(FILE) FILE  W:'$D(FILE) !
  1.  Q
  1.  ;
  1.  ;***** VALIDATES REGISTRY UPDATE DEFINITION
  1.  ;
  1.  ; .REGLST       Reference to a local array containing
  1.  ;               registry names as subscripts
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error Code
  1.  ;        0  Ok
  1.  ;
  1. UPDDEF(REGLST) ;
  1.  N RORERRDL      ; Default error location
  1.  N RORLRC        ; List of Lab result codes to check
  1.  N RORUPD        ; Update descriptor
  1.  N RORUPDPI      ; Closed root of the temporary storage
  1.  N RORVALS       ; Calculated values
  1.  ;
  1.  N RC
  1.  W !,"REGISTRY UPDATE DEFINITION",!
  1.  D CLEAR^RORERR("UPDDEF^RORUTL06")
  1.  S RORUPDPI=$NA(^TMP("RORUPD",$J))
  1.  S RC=$$PREPARE^RORUPR(.REGLST)
  1.  D:RC'<0 DEBUG^RORUPDUT
  1.  Q RC