source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUTL07.m@ 811

Last change on this file since 811 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1RORUTL07 ;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
7ERROR ;
8 D DSPSTK^RORERR()
9 Q
10 ;
11 ;***** DATA EXTRACTION TEST ENTRY POINT
12EXTRACT ;
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 ;
38GETSDT() ;
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 ;
62SELREG(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
74UPDATE ;
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
Note: See TracBrowser for help on using the repository browser.