90 lines
2.3 KiB
Mathematica
90 lines
2.3 KiB
Mathematica
RORUTL07 ;HCIOFO/SG - TEST ENTRY POINTS ; 11/1/05 1:12pm
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
Q
|
|
;
|
|
;***** DISPLAYS THE ERRORS
|
|
ERROR ;
|
|
D DSPSTK^RORERR()
|
|
Q
|
|
;
|
|
;***** DATA EXTRACTION TEST ENTRY POINT
|
|
EXTRACT ;
|
|
N RORERRDL ; Default error location
|
|
N RORERROR ; Error processing data
|
|
N RORPARM ; Application parameters
|
|
;
|
|
N RC,REGLST,REGNAME,SDT
|
|
W !,"DATA EXTRACTION & TRANSMISSION IN DEBUG MODE",!
|
|
D KILL^XUSCLEAN
|
|
S RORPARM("DEBUG")=2
|
|
S RORPARM("ERR")=1
|
|
D CLEAR^RORERR("EXTRACT^RORUTL07")
|
|
;--- Select registries
|
|
Q:$$SELREG(.REGLST)'>0
|
|
;--- Request a start date
|
|
S SDT=$$GETSDT() G:SDT<0 ERROR
|
|
;--- Extract the registry data
|
|
S RC=$$EXTRACT^ROREXT(.REGLST,SDT,,"S") G:RC<0 ERROR
|
|
Q
|
|
;
|
|
;***** REQESTS A START DATE FROM A USER
|
|
;
|
|
; Return Values:
|
|
; <0 Error Code
|
|
; "" No start date (default)
|
|
; >0 Start date
|
|
;
|
|
GETSDT() ;
|
|
;;If you enter an empty string then the individual start date
|
|
;;(from the registry record) will be used for each patient.
|
|
;
|
|
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RC,X,Y
|
|
S DIR(0)="DO^:DT:EX"
|
|
S DIR("A")="Start date for data extraction"
|
|
F X=1:1 S Y=$P($T(GETSDT+X),";;",2) Q:Y="" S DIR("?",X)=Y
|
|
S DIR("?")="This response must be a date."
|
|
D ^DIR
|
|
S RC=$S($D(DTOUT):-72,$D(DUOUT):-71,1:0)
|
|
Q $S(RC<0:RC,1:$G(Y))
|
|
;
|
|
;***** SELECTS REGISTRIES FROM THE FILE #798.1
|
|
;
|
|
; .REGLST Reference to a local variable for the list of
|
|
; registry names (subscripts) and IENs (values)
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Nothing selected
|
|
; >0 Number of selected registries
|
|
; "" Timeout or "^"
|
|
;
|
|
SELREG(REGLST) ;
|
|
N CNT,DA,DIC,DLAYGO,DTOUT,DUOUT,X,Y
|
|
K REGLST S CNT=0
|
|
;--- Select a registry
|
|
S DIC=798.1,DIC(0)="AENQ"
|
|
S DIC("A")="Select a Registry: "
|
|
F D Q:Y'>0 S REGLST($P(Y,U,2))=+Y,CNT=CNT+1
|
|
. D ^DIC
|
|
W !
|
|
Q $S($D(DTOUT)!$D(DUOUT):"",1:CNT)
|
|
;
|
|
;***** REGISTRY UPDATE TEST ENTRY POINT
|
|
UPDATE ;
|
|
N RORERRDL ; Default error location
|
|
N RORERROR ; Error processing data
|
|
N RORPARM ; Application parameters
|
|
;
|
|
N RC,REGLST,REGNAME
|
|
W !,"REGISTRY UPDATE IN DEBUG MODE",!
|
|
D KILL^XUSCLEAN
|
|
S RORPARM("DEBUG")=2
|
|
S RORPARM("ERR")=1
|
|
D CLEAR^RORERR("UPDATE^RORUTL07")
|
|
;--- Select registries
|
|
Q:$$SELREG(.REGLST)'>0
|
|
;--- Update the registry
|
|
S RC=$$UPDATE^RORUPD(.REGLST) G:RC<0 ERROR
|
|
Q
|