- 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 Mar 13, 2025@20:47:45 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
