| 1 | RORUTL07 ;HCIOFO/SG - TEST ENTRY POINTS ; 11/1/05 1:12pm
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** DISPLAYS THE ERRORS
|
|---|
| 7 | ERROR ;
|
|---|
| 8 | D DSPSTK^RORERR()
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | ;***** DATA EXTRACTION TEST ENTRY POINT
|
|---|
| 12 | EXTRACT ;
|
|---|
| 13 | N RORERRDL ; Default error location
|
|---|
| 14 | N RORERROR ; Error processing data
|
|---|
| 15 | N RORPARM ; Application parameters
|
|---|
| 16 | ;
|
|---|
| 17 | N RC,REGLST,REGNAME,SDT
|
|---|
| 18 | W !,"DATA EXTRACTION & TRANSMISSION IN DEBUG MODE",!
|
|---|
| 19 | D KILL^XUSCLEAN
|
|---|
| 20 | S RORPARM("DEBUG")=2
|
|---|
| 21 | S RORPARM("ERR")=1
|
|---|
| 22 | D CLEAR^RORERR("EXTRACT^RORUTL07")
|
|---|
| 23 | ;--- Select registries
|
|---|
| 24 | Q:$$SELREG(.REGLST)'>0
|
|---|
| 25 | ;--- Request a start date
|
|---|
| 26 | S SDT=$$GETSDT() G:SDT<0 ERROR
|
|---|
| 27 | ;--- Extract the registry data
|
|---|
| 28 | S RC=$$EXTRACT^ROREXT(.REGLST,SDT,,"S") G:RC<0 ERROR
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | ;***** REQESTS A START DATE FROM A USER
|
|---|
| 32 | ;
|
|---|
| 33 | ; Return Values:
|
|---|
| 34 | ; <0 Error Code
|
|---|
| 35 | ; "" No start date (default)
|
|---|
| 36 | ; >0 Start date
|
|---|
| 37 | ;
|
|---|
| 38 | GETSDT() ;
|
|---|
| 39 | ;;If you enter an empty string then the individual start date
|
|---|
| 40 | ;;(from the registry record) will be used for each patient.
|
|---|
| 41 | ;
|
|---|
| 42 | N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RC,X,Y
|
|---|
| 43 | S DIR(0)="DO^:DT:EX"
|
|---|
| 44 | S DIR("A")="Start date for data extraction"
|
|---|
| 45 | F X=1:1 S Y=$P($T(GETSDT+X),";;",2) Q:Y="" S DIR("?",X)=Y
|
|---|
| 46 | S DIR("?")="This response must be a date."
|
|---|
| 47 | D ^DIR
|
|---|
| 48 | S RC=$S($D(DTOUT):-72,$D(DUOUT):-71,1:0)
|
|---|
| 49 | Q $S(RC<0:RC,1:$G(Y))
|
|---|
| 50 | ;
|
|---|
| 51 | ;***** SELECTS REGISTRIES FROM THE FILE #798.1
|
|---|
| 52 | ;
|
|---|
| 53 | ; .REGLST Reference to a local variable for the list of
|
|---|
| 54 | ; registry names (subscripts) and IENs (values)
|
|---|
| 55 | ;
|
|---|
| 56 | ; Return Values:
|
|---|
| 57 | ; <0 Error code
|
|---|
| 58 | ; 0 Nothing selected
|
|---|
| 59 | ; >0 Number of selected registries
|
|---|
| 60 | ; "" Timeout or "^"
|
|---|
| 61 | ;
|
|---|
| 62 | SELREG(REGLST) ;
|
|---|
| 63 | N CNT,DA,DIC,DLAYGO,DTOUT,DUOUT,X,Y
|
|---|
| 64 | K REGLST S CNT=0
|
|---|
| 65 | ;--- Select a registry
|
|---|
| 66 | S DIC=798.1,DIC(0)="AENQ"
|
|---|
| 67 | S DIC("A")="Select a Registry: "
|
|---|
| 68 | F D Q:Y'>0 S REGLST($P(Y,U,2))=+Y,CNT=CNT+1
|
|---|
| 69 | . D ^DIC
|
|---|
| 70 | W !
|
|---|
| 71 | Q $S($D(DTOUT)!$D(DUOUT):"",1:CNT)
|
|---|
| 72 | ;
|
|---|
| 73 | ;***** REGISTRY UPDATE TEST ENTRY POINT
|
|---|
| 74 | UPDATE ;
|
|---|
| 75 | N RORERRDL ; Default error location
|
|---|
| 76 | N RORERROR ; Error processing data
|
|---|
| 77 | N RORPARM ; Application parameters
|
|---|
| 78 | ;
|
|---|
| 79 | N RC,REGLST,REGNAME
|
|---|
| 80 | W !,"REGISTRY UPDATE IN DEBUG MODE",!
|
|---|
| 81 | D KILL^XUSCLEAN
|
|---|
| 82 | S RORPARM("DEBUG")=2
|
|---|
| 83 | S RORPARM("ERR")=1
|
|---|
| 84 | D CLEAR^RORERR("UPDATE^RORUTL07")
|
|---|
| 85 | ;--- Select registries
|
|---|
| 86 | Q:$$SELREG(.REGLST)'>0
|
|---|
| 87 | ;--- Update the registry
|
|---|
| 88 | S RC=$$UPDATE^RORUPD(.REGLST) G:RC<0 ERROR
|
|---|
| 89 | Q
|
|---|
