RORRP022 ;HCIOFO/SG - RPC: SELECTION RULES ; 8/2/05 11:15am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** LOADS THE SELECTION RULES FROM THE REGISTRY RECORD
; RPC: [ROR PATIENT SELECTION RULES]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; PATIEN IEN of the registry patient (DFN)
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0)
; indicates an error (see the RPCSTK^RORERR procedure for more
; details).
;
; Otherwise, number of selection rules is returned in the RESULTS(0)
; and the subsequent nodes of the array contain the rules.
;
; RESULTS(0) Number of selection rules
;
; RESULTS(i) Selection Rule
; ^01: IEN in the SELECTION RULE multiple
; of the ROR REGISTRY RECORD file
; ^02: IEN of the Rule (in the
; ROR SELECTION RULE file)
; ^03: Name of the Rule
; ^04: Date (FileMan)
; ^05: Location IEN (Institution IEN)
; ^06: Location Name (Institution Name)
; ^07: Short Description
;
PTRULES(RESULTS,REGIEN,PATIEN) ;
N BUF,CNT,I,IEN,IENS,RC,RORBUF,RORMSG,TMP
D CLEAR^RORERR("PTRULES^RORRP022",1)
K RESULTS S RESULTS(0)=0
;--- Check the parameters
S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
. ;--- Registry IEN
. I $G(REGIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
. S REGIEN=+REGIEN
. ;--- Patient IEN
. I $G(PATIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"PATIEN",$G(PATIEN))
. S PATIEN=+PATIEN
;--- Get the IEN of the registry record
S IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN) Q:IEN'>0
;--- Load the selection rules
S IENS=","_IEN_",",TMP="@;.01I;.01E;1I;2I;2E"
D LIST^DIC(798.01,IENS,TMP,"P",,,,"AD",,,"RORBUF","RORMSG")
I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
;--- Populate the output array
S (CNT,I)=0
F S I=$O(RORBUF("DILIST",I)) Q:I'>0 D
. S BUF=RORBUF("DILIST",I,0),IEN=+$P(BUF,U,2) Q:IEN'>0
. S CNT=CNT+1,RESULTS(CNT)=BUF
. S TMP=$$GET1^DIQ(798.2,IEN_",",4,,,"RORMSG")
. S $P(RESULTS(CNT),U,7)=$S(TMP'="":TMP,1:$P(BUF,U,3))
S RESULTS(0)=CNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP022 2468 printed Dec 13, 2024@01:43:05 Page 2
RORRP022 ;HCIOFO/SG - RPC: SELECTION RULES ; 8/2/05 11:15am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** LOADS THE SELECTION RULES FROM THE REGISTRY RECORD
+6 ; RPC: [ROR PATIENT SELECTION RULES]
+7 ;
+8 ; .RESULTS Reference to a local variable where the results
+9 ; are returned to.
+10 ;
+11 ; REGIEN Registry IEN
+12 ;
+13 ; PATIEN IEN of the registry patient (DFN)
+14 ;
+15 ; Return Values:
+16 ;
+17 ; A negative value of the first "^"-piece of the RESULTS(0)
+18 ; indicates an error (see the RPCSTK^RORERR procedure for more
+19 ; details).
+20 ;
+21 ; Otherwise, number of selection rules is returned in the RESULTS(0)
+22 ; and the subsequent nodes of the array contain the rules.
+23 ;
+24 ; RESULTS(0) Number of selection rules
+25 ;
+26 ; RESULTS(i) Selection Rule
+27 ; ^01: IEN in the SELECTION RULE multiple
+28 ; of the ROR REGISTRY RECORD file
+29 ; ^02: IEN of the Rule (in the
+30 ; ROR SELECTION RULE file)
+31 ; ^03: Name of the Rule
+32 ; ^04: Date (FileMan)
+33 ; ^05: Location IEN (Institution IEN)
+34 ; ^06: Location Name (Institution Name)
+35 ; ^07: Short Description
+36 ;
PTRULES(RESULTS,REGIEN,PATIEN) ;
+1 NEW BUF,CNT,I,IEN,IENS,RC,RORBUF,RORMSG,TMP
+2 DO CLEAR^RORERR("PTRULES^RORRP022",1)
+3 KILL RESULTS
SET RESULTS(0)=0
+4 ;--- Check the parameters
+5 SET RC=0
Begin DoDot:1
+6 ;--- Registry IEN
+7 IF $GET(REGIEN)'>0
Begin DoDot:2
+8 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+9 SET REGIEN=+REGIEN
+10 ;--- Patient IEN
+11 IF $GET(PATIEN)'>0
Begin DoDot:2
+12 SET RC=$$ERROR^RORERR(-88,,,,"PATIEN",$GET(PATIEN))
End DoDot:2
QUIT
+13 SET PATIEN=+PATIEN
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+14 ;--- Get the IEN of the registry record
+15 SET IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN)
if IEN'>0
QUIT
+16 ;--- Load the selection rules
+17 SET IENS=","_IEN_","
SET TMP="@;.01I;.01E;1I;2I;2E"
+18 DO LIST^DIC(798.01,IENS,TMP,"P",,,,"AD",,,"RORBUF","RORMSG")
+19 IF $GET(DIERR)
Begin DoDot:1
+20 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+21 ;--- Populate the output array
+22 SET (CNT,I)=0
+23 FOR
SET I=$ORDER(RORBUF("DILIST",I))
if I'>0
QUIT
Begin DoDot:1
+24 SET BUF=RORBUF("DILIST",I,0)
SET IEN=+$PIECE(BUF,U,2)
if IEN'>0
QUIT
+25 SET CNT=CNT+1
SET RESULTS(CNT)=BUF
+26 SET TMP=$$GET1^DIQ(798.2,IEN_",",4,,,"RORMSG")
+27 SET $PIECE(RESULTS(CNT),U,7)=$SELECT(TMP'="":TMP,1:$PIECE(BUF,U,3))
End DoDot:1
+28 SET RESULTS(0)=CNT
+29 QUIT
