source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP022.m@ 770

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1RORRP022 ;HCIOFO/SG - RPC: SELECTION RULES ; 8/2/05 11:15am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** LOADS THE SELECTION RULES FROM THE REGISTRY RECORD
7 ; RPC: [ROR PATIENT SELECTION RULES]
8 ;
9 ; .RESULTS Reference to a local variable where the results
10 ; are returned to.
11 ;
12 ; REGIEN Registry IEN
13 ;
14 ; PATIEN IEN of the registry patient (DFN)
15 ;
16 ; Return Values:
17 ;
18 ; A negative value of the first "^"-piece of the RESULTS(0)
19 ; indicates an error (see the RPCSTK^RORERR procedure for more
20 ; details).
21 ;
22 ; Otherwise, number of selection rules is returned in the RESULTS(0)
23 ; and the subsequent nodes of the array contain the rules.
24 ;
25 ; RESULTS(0) Number of selection rules
26 ;
27 ; RESULTS(i) Selection Rule
28 ; ^01: IEN in the SELECTION RULE multiple
29 ; of the ROR REGISTRY RECORD file
30 ; ^02: IEN of the Rule (in the
31 ; ROR SELECTION RULE file)
32 ; ^03: Name of the Rule
33 ; ^04: Date (FileMan)
34 ; ^05: Location IEN (Institution IEN)
35 ; ^06: Location Name (Institution Name)
36 ; ^07: Short Description
37 ;
38PTRULES(RESULTS,REGIEN,PATIEN) ;
39 N BUF,CNT,I,IEN,IENS,RC,RORBUF,RORMSG,TMP
40 D CLEAR^RORERR("PTRULES^RORRP022",1)
41 K RESULTS S RESULTS(0)=0
42 ;--- Check the parameters
43 S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
44 . ;--- Registry IEN
45 . I $G(REGIEN)'>0 D Q
46 . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
47 . S REGIEN=+REGIEN
48 . ;--- Patient IEN
49 . I $G(PATIEN)'>0 D Q
50 . . S RC=$$ERROR^RORERR(-88,,,,"PATIEN",$G(PATIEN))
51 . S PATIEN=+PATIEN
52 ;--- Get the IEN of the registry record
53 S IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN) Q:IEN'>0
54 ;--- Load the selection rules
55 S IENS=","_IEN_",",TMP="@;.01I;.01E;1I;2I;2E"
56 D LIST^DIC(798.01,IENS,TMP,"P",,,,"AD",,,"RORBUF","RORMSG")
57 I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
58 . S RC=$$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
59 ;--- Populate the output array
60 S (CNT,I)=0
61 F S I=$O(RORBUF("DILIST",I)) Q:I'>0 D
62 . S BUF=RORBUF("DILIST",I,0),IEN=+$P(BUF,U,2) Q:IEN'>0
63 . S CNT=CNT+1,RESULTS(CNT)=BUF
64 . S TMP=$$GET1^DIQ(798.2,IEN_",",4,,,"RORMSG")
65 . S $P(RESULTS(CNT),U,7)=$S(TMP'="":TMP,1:$P(BUF,U,3))
66 S RESULTS(0)=CNT
67 Q
Note: See TracBrowser for help on using the repository browser.