ORIRPCCL ; SLC/AGP - Information panel On-Click RPC ;Jun 11, 2025@12:22:01
;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
;
;
Q
;
GETCLICK(RESULTS,IJSON) ;
N DARRAY,DFN,ERROR,IDS,INFOARRAY,INPUTS,ISNAT,LASTUPDATE,PKG,PKGIEN,SUB,SRCDATA,TARRAY,USER
S SUB="ORIRPCCL CLICKEVENT"
K ^TMP(SUB,$J)
S RESULTS=$NA(^TMP(SUB,$J))
D DECODE^XLFJSON("IJSON","INPUTS","ERROR")
I $D(ERROR) D SETERROR(.TARRAY,"Problem decoding JSON document.") G ENX
S (SRCDATA("sourceId"),IDS)=$G(INPUTS("id")) I IDS="" D SETERROR(.TARRAY,"Panel ids not found") G ENX
S DFN=+$G(INPUTS("patientId")) I DFN=0 D SETERROR(.TARRAY,"Patient id not found.") G ENX
S PKG=$G(INPUTS("package")) I PKG="" D SETERROR(.TARRAY,"Package name not found.") G ENX
S USER=+$G(INPUTS("connectionUser")) I USER=0 D SETERROR(.TARRAY,"Connected user information not found.") G ENX
S ISNAT=$S($G(INPUTS("isNational"))="true":1,$G(INPUTS("isNational"))="false":0,1:"") I ISNAT="" D SETERROR(.TARRAY,"Is national value not found.") G ENX
S LASTUPDATE=+$G(INPUTS("lastUpdated"))
I '$$GETINFOARRAY(.INFOARRAY,IDS,.TARRAY,LASTUPDATE) G ENX
I '$$REQDATA(.INFOARRAY,.INPUTS,.TARRAY,.DARRAY) G ENX
I '$$PROCESS(DFN,USER,IDS,PKG,SUB,.INFOARRAY,.DARRAY,.TARRAY,.INPUTS) G ENX
S TARRAY("success")="true"
ENX ;
K ^TMP(SUB,$J)
D ENCODE^XLFJSON("TARRAY",$NA(^TMP(SUB,$J)),"ERROR")
Q
;
GETINFOARRAY(INFOARRAY,IDS,TARRAY,LASTUPDATE) ;
N LIDX,PIDX,PKIDX,TIDX,LD
S TIDX=$P(IDS,";"),PKIDX=$P(IDS,";",2),LIDX=$P(IDS,";",3),PIDX=$P(IDS,";",4)
;additonal check to make sure can get to InfoPanel Section Button
I TIDX=0 D SETERROR(.TARRAY,"Top level entry in file #101.71 not found.") Q 0
I PKIDX=0 D SETERROR(.TARRAY,"Package level entry in file #101.71 entry "_$S(ISNAT=1:"National",1:"Local")_" not found.") Q 0
I LIDX=0 D SETERROR(.TARRAY,"Location level entry in file #101.71 entry "_$S(ISNAT=1:"National",1:"Local")_"for package entry "_PKG_" not found.") Q 0
I PIDX=0 D SETERROR(.TARRAY,"Panel level entry in file #101.71 entry "_$S(ISNAT=1:"National",1:"Local")_"for package entry "_PKG_" not found.") Q 0
S LD=+$P($G(^ORI(101.71,TIDX,0)),U,3)
;I LASTUPDATE>0,LD>0,$$FMDIFF^XLFDT(LD,LASTUPDATE,2)>0 D SETERROR(.TARRAY,"Panels have been updated please try again.") S TARRAY("refreshAllInfoPanels")="true" Q 0
M INFOARRAY=^ORI(101.71,TIDX,"PKG",PKIDX,"LOC",LIDX,"ITM",PIDX)
Q 1
;
PROCESS(DFN,USER,IDS,PKG,SUB,INFOARRAY,DARRAY,RESULTS,INPUTS) ;
N ACT,EID,ETYPE,IEN,IDX,MPIEN,NODE,REQDATA,RET,ROUTINE,RTN,TAG,TARRAY,TEMP,URL
S ACT=$P(INFOARRAY(30),U)
S ACT=$$GETCOMP^ORDD71(ACT)
S EID=+$P($G(INFOARRAY(30)),U,5)
I ACT="actShowEditor" Q $$GETEDITOR^OREDITOR(DFN,USER,IDS,PKG,EID,.DARRAY,.RESULTS)
I ACT="actShowHTMLEditor" Q $$GETEDITOR^ORHEDITOR(DFN,USER,IDS,PKG,EID,.DARRAY,.RESULTS)
M REQDATA("requiredData")=DARRAY
S MPIEN=+$P(INFOARRAY(30),U,3)
I ACT="actShowDetail"!(ACT="actShowMessage")&(MPIEN=0) D SETDETAILS(.INPUTS,.RESULTS) Q 1
I ACT="actShowUrl",MPIEN=0 D SETURL(.INFOARRAY,.INPUTS,.RESULTS) Q 1
Q:'MPIEN 0 ; ajb, hard error when no detail code set and CALL DETAIL RPC=YES
;S REQDATA("userId")=USER
S RET=$$ONCLICKEXECODE^ORIUTL(SUB,DFN,USER,"ONCLICK",IDS,MPIEN,.REQDATA)
I +RET<1 D SETERROR(.RESULTS,$P(RET,U,2)) Q 0
I ACT="actShowUrl" S RESULTS("results")=$G(^TMP(SUB,$J,"CODE",IDS,"results",1)) Q 1
S IDX=0 F S IDX=$O(^TMP(SUB,$J,"CODE",IDS,"results",IDX)) Q:IDX'>0 D
. S TARRAY(IDX)=^TMP(SUB,$J,"CODE",IDS,"results",IDX)_$C(13)_$C(10)
M RESULTS("results","\")=TARRAY
Q 1
;
REQDATA(INFOARRAY,INPUTS,ARRAY,DARRAY) ;
N DIEN,DSIEN,DTYPE,DNAME,DVALUE,ERROR,FOUND,HASOPT,IEN,IDX,NODE
N OPTARRAY,OPTFOUND,REQ,RESULT,RIDX,RIEN,TMP
S RESULT=1
I '$D(INPUTS("requiredData")) Q RESULT
S RIDX=0,ERROR=""
F S RIDX=$O(INPUTS("requiredData",RIDX)) Q:RIDX'>0!(ERROR'="") D
.S DTYPE=$G(INPUTS("requiredData",RIDX,"dataType","name")) I DTYPE="" Q
.S DIEN=+$O(^ORI(101.73,"G",DTYPE,"")) I DIEN=0 S ERROR="Could not find data type of "_DTYPE Q
.K OPTARRAY
.S DNAME="",OPTFOUND=0,HASOPT=0
.F S DNAME=$O(INPUTS("requiredData",RIDX,"dataType","data",DNAME)) Q:DNAME=""!(ERROR'="") D
.. S DVALUE=$G(INPUTS("requiredData",RIDX,"dataType","data",DNAME))
.. S DSIEN=$O(^ORI(101.73,DIEN,40,"B",DNAME,"")) I DSIEN=0 S ERROR="Cannot find the data type of "_DNAME
.. S REQ=$P($G(^ORI(101.73,DIEN,40,DSIEN,0)),U,2)
.. S DARRAY(DTYPE,DNAME)=DVALUE
.. I REQ="N" Q
.. I REQ="Y",DVALUE="" S ERROR="Value for "_DTYPE_" data property "_DNAME_" not found." Q
.. I REQ="O" S HASOPT=1,OPTFOUND=$S(DVALUE'="":1,1:0),OPTARRAY(DNAME)=""
.I HASOPT,'OPTFOUND D Q
..S DNAME="",TMP=""
..F S DNAME=$O(OPTARRAY(DNAME)) Q:DNAME="" S TMP=TMP_$S(TMP'="":", ",1:"")_DNAME
..S ERROR="Value for "_DTYPE_" data propert"_$S($L(TMP,",")>1:"ies ",1:"y ")_TMP_" not found."
;Check database to validate the GUI is passing requried data back to VistA based off current file definition
I ERROR="" D
.S RIDX=0 F S RIDX=$O(INFOARRAY("REQD",RIDX)) Q:RIDX'>0!(ERROR'="") D
..S NODE=$G(INFOARRAY("REQD",RIDX,0)) I '+$P(NODE,U,2) Q
..S IEN=$P(NODE,U)
..S IDX=0,FOUND=0,TMP=""
..S DTYPE=$P($G(^ORI(101.73,IEN,0)),U,3) I DTYPE="" Q
..;check for at least one OR value is defined
..F S IDX=$O(^ORI(101.73,IEN,40,"R","O",IDX)) Q:IDX'>0!(FOUND=1) D
...S DNAME=$P($G(^ORI(101.73,IEN,40,IDX,0)),U) I DNAME="" Q
...I $G(DARRAY(DTYPE,DNAME))'="" S FOUND=1 Q
...S TMP=TMP_$S(TMP'="":", "_DNAME,1:DNAME)
..I 'FOUND,TMP'="" S ERROR="Value for "_DTYPE_" data propert"_$S($L(TMP,",")>1:"ies ",1:"y ")_TMP_" not found." Q
..;check for all required data is passed in
..S IDX=""
..F S IDX=$O(^ORI(101.73,IEN,40,"R","Y",IDX)) Q:IDX'>0!(ERROR'="") D
...S DNAME=$P($G(^ORI(101.73,IEN,40,IDX,0)),U) I DNAME="" Q
...I $G(DARRAY(DTYPE,DNAME))="" S ERROR="Value for "_DTYPE_" data property "_DNAME_" not found."
I ERROR'="" D SETERROR(.ARRAY,ERROR) S RESULT=0
Q RESULT
;
SETERROR(ARRAY,ERROR) ;
S ARRAY("success")="false"
S ARRAY("error")=ERROR
Q
;
SETDETAILS(INPUTS,RESULTS) ;
N DA,DATA,DFN,IDS
S IDS=$G(INPUTS("id"))
S DFN=+$G(INPUTS("patientId"))
S DA(0)=$P(IDS,";"),DA(1)=$P(IDS,";",2),DA(2)=$P(IDS,";",3),DA(3)=$P(IDS,";",4)
D DTEXT^ORIRPC(.DA,.DATA,DFN,"",1,"")
M RESULTS("results","\")=DATA("presentation",1,"detailText","\")
Q
;
SETURL(INFOARRAY,INPUTS,RESULTS) ;
N DARRAY,DFN,IDX,NAME,TYPE,URL,VALUE
M DARRAY=INPUTS("requiredData")
S DFN=INPUTS("patientId")
S URL=$P($G(INFOARRAY("URL")),U)
S URL=$$STRREP^ORIUTL(URL,"%DFN",DFN)
S IDX=0 F S IDX=$O(DARRAY(IDX)) Q:IDX'>0 D
.S TYPE=$G(DARRAY(IDX,"dataType","name"))
.S NAME="" F S NAME=$O(DARRAY(IDX,"dataType","data",NAME)) Q:NAME="" D
..I NAME'="id" Q
..S VALUE=$G(DARRAY(IDX,"dataType","data",NAME))
..I TYPE="dataDivision" S URL=$$STRREP^ORIUTL(URL,"%DIVISION",VALUE) Q
..I TYPE="dataPort" S URL=$$STRREP^ORIUTL(URL,"%PORT",VALUE) Q
..I TYPE="dataServer" S URL=$$STRREP^ORIUTL(URL,"%SRV",VALUE) Q
..I TYPE="dataStationNumber" S URL=$$STRREP^ORIUTL(URL,"%STATION",VALUE) Q
..I TYPE="dataUserInformation" S URL=$$STRREP^ORIUTL(URL,"%DUZ",VALUE)
I URL["%H" S URL=$$STRREP^ORIUTL(URL,"%H",$H)
I URL["%J" S URL=$$STRREP^ORIUTL(URL,"%J",$J)
S RESULTS("results")=URL
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORIRPCCL 7282 printed May 25, 2026@12:35:10 Page 2
ORIRPCCL ; SLC/AGP - Information panel On-Click RPC ;Jun 11, 2025@12:22:01
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
+2 ;
+3 ;
+4 QUIT
+5 ;
GETCLICK(RESULTS,IJSON) ;
+1 NEW DARRAY,DFN,ERROR,IDS,INFOARRAY,INPUTS,ISNAT,LASTUPDATE,PKG,PKGIEN,SUB,SRCDATA,TARRAY,USER
+2 SET SUB="ORIRPCCL CLICKEVENT"
+3 KILL ^TMP(SUB,$JOB)
+4 SET RESULTS=$NAME(^TMP(SUB,$JOB))
+5 DO DECODE^XLFJSON("IJSON","INPUTS","ERROR")
+6 IF $DATA(ERROR)
DO SETERROR(.TARRAY,"Problem decoding JSON document.")
GOTO ENX
+7 SET (SRCDATA("sourceId"),IDS)=$GET(INPUTS("id"))
IF IDS=""
DO SETERROR(.TARRAY,"Panel ids not found")
GOTO ENX
+8 SET DFN=+$GET(INPUTS("patientId"))
IF DFN=0
DO SETERROR(.TARRAY,"Patient id not found.")
GOTO ENX
+9 SET PKG=$GET(INPUTS("package"))
IF PKG=""
DO SETERROR(.TARRAY,"Package name not found.")
GOTO ENX
+10 SET USER=+$GET(INPUTS("connectionUser"))
IF USER=0
DO SETERROR(.TARRAY,"Connected user information not found.")
GOTO ENX
+11 SET ISNAT=$SELECT($GET(INPUTS("isNational"))="true":1,$GET(INPUTS("isNational"))="false":0,1:"")
IF ISNAT=""
DO SETERROR(.TARRAY,"Is national value not found.")
GOTO ENX
+12 SET LASTUPDATE=+$GET(INPUTS("lastUpdated"))
+13 IF '$$GETINFOARRAY(.INFOARRAY,IDS,.TARRAY,LASTUPDATE)
GOTO ENX
+14 IF '$$REQDATA(.INFOARRAY,.INPUTS,.TARRAY,.DARRAY)
GOTO ENX
+15 IF '$$PROCESS(DFN,USER,IDS,PKG,SUB,.INFOARRAY,.DARRAY,.TARRAY,.INPUTS)
GOTO ENX
+16 SET TARRAY("success")="true"
ENX ;
+1 KILL ^TMP(SUB,$JOB)
+2 DO ENCODE^XLFJSON("TARRAY",$NAME(^TMP(SUB,$JOB)),"ERROR")
+3 QUIT
+4 ;
GETINFOARRAY(INFOARRAY,IDS,TARRAY,LASTUPDATE) ;
+1 NEW LIDX,PIDX,PKIDX,TIDX,LD
+2 SET TIDX=$PIECE(IDS,";")
SET PKIDX=$PIECE(IDS,";",2)
SET LIDX=$PIECE(IDS,";",3)
SET PIDX=$PIECE(IDS,";",4)
+3 ;additonal check to make sure can get to InfoPanel Section Button
+4 IF TIDX=0
DO SETERROR(.TARRAY,"Top level entry in file #101.71 not found.")
QUIT 0
+5 IF PKIDX=0
DO SETERROR(.TARRAY,"Package level entry in file #101.71 entry "_$SELECT(ISNAT=1:"National",1:"Local")_" not found.")
QUIT 0
+6 IF LIDX=0
DO SETERROR(.TARRAY,"Location level entry in file #101.71 entry "_$SELECT(ISNAT=1:"National",1:"Local")_"for package entry "_PKG_" not found.")
QUIT 0
+7 IF PIDX=0
DO SETERROR(.TARRAY,"Panel level entry in file #101.71 entry "_$SELECT(ISNAT=1:"National",1:"Local")_"for package entry "_PKG_" not found.")
QUIT 0
+8 SET LD=+$PIECE($GET(^ORI(101.71,TIDX,0)),U,3)
+9 ;I LASTUPDATE>0,LD>0,$$FMDIFF^XLFDT(LD,LASTUPDATE,2)>0 D SETERROR(.TARRAY,"Panels have been updated please try again.") S TARRAY("refreshAllInfoPanels")="true" Q 0
+10 MERGE INFOARRAY=^ORI(101.71,TIDX,"PKG",PKIDX,"LOC",LIDX,"ITM",PIDX)
+11 QUIT 1
+12 ;
PROCESS(DFN,USER,IDS,PKG,SUB,INFOARRAY,DARRAY,RESULTS,INPUTS) ;
+1 NEW ACT,EID,ETYPE,IEN,IDX,MPIEN,NODE,REQDATA,RET,ROUTINE,RTN,TAG,TARRAY,TEMP,URL
+2 SET ACT=$PIECE(INFOARRAY(30),U)
+3 SET ACT=$$GETCOMP^ORDD71(ACT)
+4 SET EID=+$PIECE($GET(INFOARRAY(30)),U,5)
+5 IF ACT="actShowEditor"
QUIT $$GETEDITOR^OREDITOR(DFN,USER,IDS,PKG,EID,.DARRAY,.RESULTS)
+6 IF ACT="actShowHTMLEditor"
QUIT $$GETEDITOR^ORHEDITOR(DFN,USER,IDS,PKG,EID,.DARRAY,.RESULTS)
+7 MERGE REQDATA("requiredData")=DARRAY
+8 SET MPIEN=+$PIECE(INFOARRAY(30),U,3)
+9 IF ACT="actShowDetail"!(ACT="actShowMessage")&(MPIEN=0)
DO SETDETAILS(.INPUTS,.RESULTS)
QUIT 1
+10 IF ACT="actShowUrl"
IF MPIEN=0
DO SETURL(.INFOARRAY,.INPUTS,.RESULTS)
QUIT 1
+11 ; ajb, hard error when no detail code set and CALL DETAIL RPC=YES
if 'MPIEN
QUIT 0
+12 ;S REQDATA("userId")=USER
+13 SET RET=$$ONCLICKEXECODE^ORIUTL(SUB,DFN,USER,"ONCLICK",IDS,MPIEN,.REQDATA)
+14 IF +RET<1
DO SETERROR(.RESULTS,$PIECE(RET,U,2))
QUIT 0
+15 IF ACT="actShowUrl"
SET RESULTS("results")=$GET(^TMP(SUB,$JOB,"CODE",IDS,"results",1))
QUIT 1
+16 SET IDX=0
FOR
SET IDX=$ORDER(^TMP(SUB,$JOB,"CODE",IDS,"results",IDX))
if IDX'>0
QUIT
Begin DoDot:1
+17 SET TARRAY(IDX)=^TMP(SUB,$JOB,"CODE",IDS,"results",IDX)_$CHAR(13)_$CHAR(10)
End DoDot:1
+18 MERGE RESULTS("results","\")=TARRAY
+19 QUIT 1
+20 ;
REQDATA(INFOARRAY,INPUTS,ARRAY,DARRAY) ;
+1 NEW DIEN,DSIEN,DTYPE,DNAME,DVALUE,ERROR,FOUND,HASOPT,IEN,IDX,NODE
+2 NEW OPTARRAY,OPTFOUND,REQ,RESULT,RIDX,RIEN,TMP
+3 SET RESULT=1
+4 IF '$DATA(INPUTS("requiredData"))
QUIT RESULT
+5 SET RIDX=0
SET ERROR=""
+6 FOR
SET RIDX=$ORDER(INPUTS("requiredData",RIDX))
if RIDX'>0!(ERROR'="")
QUIT
Begin DoDot:1
+7 SET DTYPE=$GET(INPUTS("requiredData",RIDX,"dataType","name"))
IF DTYPE=""
QUIT
+8 SET DIEN=+$ORDER(^ORI(101.73,"G",DTYPE,""))
IF DIEN=0
SET ERROR="Could not find data type of "_DTYPE
QUIT
+9 KILL OPTARRAY
+10 SET DNAME=""
SET OPTFOUND=0
SET HASOPT=0
+11 FOR
SET DNAME=$ORDER(INPUTS("requiredData",RIDX,"dataType","data",DNAME))
if DNAME=""!(ERROR'="")
QUIT
Begin DoDot:2
+12 SET DVALUE=$GET(INPUTS("requiredData",RIDX,"dataType","data",DNAME))
+13 SET DSIEN=$ORDER(^ORI(101.73,DIEN,40,"B",DNAME,""))
IF DSIEN=0
SET ERROR="Cannot find the data type of "_DNAME
+14 SET REQ=$PIECE($GET(^ORI(101.73,DIEN,40,DSIEN,0)),U,2)
+15 SET DARRAY(DTYPE,DNAME)=DVALUE
+16 IF REQ="N"
QUIT
+17 IF REQ="Y"
IF DVALUE=""
SET ERROR="Value for "_DTYPE_" data property "_DNAME_" not found."
QUIT
+18 IF REQ="O"
SET HASOPT=1
SET OPTFOUND=$SELECT(DVALUE'="":1,1:0)
SET OPTARRAY(DNAME)=""
End DoDot:2
+19 IF HASOPT
IF 'OPTFOUND
Begin DoDot:2
+20 SET DNAME=""
SET TMP=""
+21 FOR
SET DNAME=$ORDER(OPTARRAY(DNAME))
if DNAME=""
QUIT
SET TMP=TMP_$SELECT(TMP'="":", ",1:"")_DNAME
+22 SET ERROR="Value for "_DTYPE_" data propert"_$SELECT($LENGTH(TMP,",")>1:"ies ",1:"y ")_TMP_" not found."
End DoDot:2
QUIT
End DoDot:1
+23 ;Check database to validate the GUI is passing requried data back to VistA based off current file definition
+24 IF ERROR=""
Begin DoDot:1
+25 SET RIDX=0
FOR
SET RIDX=$ORDER(INFOARRAY("REQD",RIDX))
if RIDX'>0!(ERROR'="")
QUIT
Begin DoDot:2
+26 SET NODE=$GET(INFOARRAY("REQD",RIDX,0))
IF '+$PIECE(NODE,U,2)
QUIT
+27 SET IEN=$PIECE(NODE,U)
+28 SET IDX=0
SET FOUND=0
SET TMP=""
+29 SET DTYPE=$PIECE($GET(^ORI(101.73,IEN,0)),U,3)
IF DTYPE=""
QUIT
+30 ;check for at least one OR value is defined
+31 FOR
SET IDX=$ORDER(^ORI(101.73,IEN,40,"R","O",IDX))
if IDX'>0!(FOUND=1)
QUIT
Begin DoDot:3
+32 SET DNAME=$PIECE($GET(^ORI(101.73,IEN,40,IDX,0)),U)
IF DNAME=""
QUIT
+33 IF $GET(DARRAY(DTYPE,DNAME))'=""
SET FOUND=1
QUIT
+34 SET TMP=TMP_$SELECT(TMP'="":", "_DNAME,1:DNAME)
End DoDot:3
+35 IF 'FOUND
IF TMP'=""
SET ERROR="Value for "_DTYPE_" data propert"_$SELECT($LENGTH(TMP,",")>1:"ies ",1:"y ")_TMP_" not found."
QUIT
+36 ;check for all required data is passed in
+37 SET IDX=""
+38 FOR
SET IDX=$ORDER(^ORI(101.73,IEN,40,"R","Y",IDX))
if IDX'>0!(ERROR'="")
QUIT
Begin DoDot:3
+39 SET DNAME=$PIECE($GET(^ORI(101.73,IEN,40,IDX,0)),U)
IF DNAME=""
QUIT
+40 IF $GET(DARRAY(DTYPE,DNAME))=""
SET ERROR="Value for "_DTYPE_" data property "_DNAME_" not found."
End DoDot:3
End DoDot:2
End DoDot:1
+41 IF ERROR'=""
DO SETERROR(.ARRAY,ERROR)
SET RESULT=0
+42 QUIT RESULT
+43 ;
SETERROR(ARRAY,ERROR) ;
+1 SET ARRAY("success")="false"
+2 SET ARRAY("error")=ERROR
+3 QUIT
+4 ;
SETDETAILS(INPUTS,RESULTS) ;
+1 NEW DA,DATA,DFN,IDS
+2 SET IDS=$GET(INPUTS("id"))
+3 SET DFN=+$GET(INPUTS("patientId"))
+4 SET DA(0)=$PIECE(IDS,";")
SET DA(1)=$PIECE(IDS,";",2)
SET DA(2)=$PIECE(IDS,";",3)
SET DA(3)=$PIECE(IDS,";",4)
+5 DO DTEXT^ORIRPC(.DA,.DATA,DFN,"",1,"")
+6 MERGE RESULTS("results","\")=DATA("presentation",1,"detailText","\")
+7 QUIT
+8 ;
SETURL(INFOARRAY,INPUTS,RESULTS) ;
+1 NEW DARRAY,DFN,IDX,NAME,TYPE,URL,VALUE
+2 MERGE DARRAY=INPUTS("requiredData")
+3 SET DFN=INPUTS("patientId")
+4 SET URL=$PIECE($GET(INFOARRAY("URL")),U)
+5 SET URL=$$STRREP^ORIUTL(URL,"%DFN",DFN)
+6 SET IDX=0
FOR
SET IDX=$ORDER(DARRAY(IDX))
if IDX'>0
QUIT
Begin DoDot:1
+7 SET TYPE=$GET(DARRAY(IDX,"dataType","name"))
+8 SET NAME=""
FOR
SET NAME=$ORDER(DARRAY(IDX,"dataType","data",NAME))
if NAME=""
QUIT
Begin DoDot:2
+9 IF NAME'="id"
QUIT
+10 SET VALUE=$GET(DARRAY(IDX,"dataType","data",NAME))
+11 IF TYPE="dataDivision"
SET URL=$$STRREP^ORIUTL(URL,"%DIVISION",VALUE)
QUIT
+12 IF TYPE="dataPort"
SET URL=$$STRREP^ORIUTL(URL,"%PORT",VALUE)
QUIT
+13 IF TYPE="dataServer"
SET URL=$$STRREP^ORIUTL(URL,"%SRV",VALUE)
QUIT
+14 IF TYPE="dataStationNumber"
SET URL=$$STRREP^ORIUTL(URL,"%STATION",VALUE)
QUIT
+15 IF TYPE="dataUserInformation"
SET URL=$$STRREP^ORIUTL(URL,"%DUZ",VALUE)
End DoDot:2
End DoDot:1
+16 IF URL["%H"
SET URL=$$STRREP^ORIUTL(URL,"%H",$HOROLOG)
+17 IF URL["%J"
SET URL=$$STRREP^ORIUTL(URL,"%J",$JOB)
+18 SET RESULTS("results")=URL
+19 QUIT
+20 ;
