source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP041.m@ 1704

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1RORRP041 ;HCIOFO/SG - RPC: REGISTRY-SPECIFIC LAB RESULTS ; 8/25/05 12:24pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** LOADS AND PROCESSES CD4 AND VIRAL LOAD RESULTS
7 ;
8 ; .ROR8DST( Reference to the Lab search descriptor.
9 ; See the $$LTSEARCH^RORUTL10 for details
10 ;
11 ; "RORPTR") Index of the last node in the destination buffer
12 ;
13 ; "RORSTATS",
14 ; Group,
15 ; "LAST") Latest
16 ; ^01: Result Value
17 ; ^02: Date
18 ; "MAX") Highest
19 ; ^01: Result Value
20 ; ^02: Date
21 ; "MIN") Lowest
22 ; ^01: Result Value
23 ; ^02: Date
24 ;
25 ; INVDT IEN of the Lab test (inverted date)
26 ;
27 ; .RESULT Reference to a local variable, which contains the
28 ; result in the same format as it is stored into
29 ; the destination array by default.
30 ;
31 ; Return Values:
32 ; <0 Error code (the search will be aborted)
33 ; 0 Ok
34 ; 1 Skip this result
35 ; 2 Skip this and all remaining results
36 ;
37LOADLT(ROR8DST,INVDT,RESULT) ;
38 N BUF,GROUP,LTDT,LTVAL,TMP
39 S LTDT=$P($G(RESULT(1)),U,2) Q:LTDT'>0 1 ; Date of the test
40 S LTVAL=$$TRIM^XLFSTR($P(RESULT(1),U,3)) ; Result value
41 S GROUP=+$P($G(RESULT(2)),U,3) Q:GROUP'>0 1 ; Code of the group
42 ;
43 ;=== Create and store the segment
44 S BUF="LTR"_U_$P(RESULT(1),U)
45 S $P(BUF,U,3,4)=LTDT_U_LTVAL
46 S $P(BUF,U,5,8)=$P(RESULT(2),U,1,4)
47 S ROR8DST("RORPTR")=$G(ROR8DST("RORPTR"))+1
48 S @ROR8DST@(ROR8DST("RORPTR"))=BUF
49 ;
50 ;=== Most recent result of the group
51 D:LTDT>$P($G(ROR8DST("RORSTATS",GROUP,"LAST")),U,2)
52 . S ROR8DST("RORSTATS",GROUP,"LAST")=LTVAL_U_LTDT
53 ;
54 ;=== Numeric results
55 D:$$NUMERIC^RORUTL05(LTVAL)
56 . ;--- Lowest result value of the group
57 . S TMP=+$G(ROR8DST("RORSTATS",GROUP,"MIN"))
58 . S:'TMP!(LTVAL<TMP) ROR8DST("RORSTATS",GROUP,"MIN")=LTVAL_U_LTDT
59 . ;--- Highest result value of the group
60 . S TMP=+$G(ROR8DST("RORSTATS",GROUP,"MAX"))
61 . S:LTVAL>TMP ROR8DST("RORSTATS",GROUP,"MAX")=LTVAL_U_LTDT
62 ;
63 ;=== Success
64 Q 0
65 ;
66 ;***** LOADS THE PATIENT'S REGISTRY-SPECIFIC LAB RESULTS
67 ; RPC: [ROR PATIENT REGISTRY LABS]
68 ;
69 ; .RESULTS Reference to a local variable where the results
70 ; are returned to.
71 ;
72 ; REGIEN Registry IEN
73 ;
74 ; PATIEN IEN of the registry patient (DFN)
75 ;
76 ; Return Values:
77 ;
78 ; A negative value of the first "^"-piece of the RESULTS(0)
79 ; indicates an error (see the RPCSTK^RORERR procedure for more
80 ; details).
81 ;
82 ; Otherwise, zero is returned in the @RESULTS@(0) and the
83 ; subsequent nodes of the global array contain the data.
84 ;
85 ; @RESULTS@(0) 0
86 ;
87 ; @RESULTS@(i) Registry-specific Lab Result
88 ; ^01: "LTR"
89 ; ^02: Result IEN (inverted date/time)
90 ; ^03: Date/time of the test (FileMan)
91 ; ^04: Result
92 ; ^05: Test IEN (in file #60)
93 ; ^06: Test name
94 ; ^07: Code of the group
95 ; ^08: Group name
96 ;
97 ; @RESULTS@(i) Lab Group Statistics
98 ; ^01: "LTG"
99 ; ^02: Code of the group
100 ; ^03: Group name
101 ; ^04: Latest result value
102 ; ^05: Date of the latest result (FileMan)
103 ; ^06: Lowest result value
104 ; ^07: Date of the lowest value (FileMan)
105 ;
106LOADPRL(RESULTS,REGIEN,PATIEN) ;
107 N BUF,GRP,NAME,PTR,RC,RORBUF,RORERRDL,TMP
108 D CLEAR^RORERR("LOAD^RORRP041",1)
109 K RESULTS S RESULTS=$$ALLOC^RORTMP() S @RESULTS@(0)=0
110 ;
111 ;=== Check the parameters
112 S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
113 . ;--- Registry IEN
114 . I $G(REGIEN)'>0 D Q
115 . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
116 . S REGIEN=+REGIEN
117 . ;--- Patient IEN
118 . I $G(PATIEN)'>0 D Q
119 . . S RC=$$ERROR^RORERR(-88,,,,"PATIEN",$G(PATIEN))
120 . S PATIEN=+PATIEN
121 ;
122 ;=== Search for registry-specific lab results
123 S RORBUF=RESULTS
124 S RORBUF("RORCB")="$$LOADLT^RORRP041"
125 S RC=$$LTSEARCH^RORUTL10(PATIEN,+REGIEN,.RORBUF)
126 I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
127 ;
128 ;=== Store the group statistics
129 S PTR=+$O(@RESULTS@(""),-1)
130 S GRP=0
131 F S GRP=$O(RORBUF("RORSTATS",GRP)) Q:GRP'>0 D
132 . S TMP=$$ITEMIEN^RORUTL09(3,REGIEN,GRP,.NAME)
133 . S BUF="LTG"_U_GRP_U_NAME
134 . S $P(BUF,U,4,5)=$G(RORBUF("RORSTATS",GRP,"LAST"))
135 . S $P(BUF,U,6,7)=$G(RORBUF("RORSTATS",GRP,"MIN"))
136 . S PTR=PTR+1,@RESULTS@(PTR)=BUF
137 Q
Note: See TracBrowser for help on using the repository browser.