ORIUTL ;X/AJB - PANELS UI UTILITIES ;Mar 24, 2025@13:14:52
;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
;
Q
;
CLEARSIZE ;
N DIC,DIR,DIK,DIROUT,DIRUT,DTOUT,DUOUT
N IDX,INST,NODE,ORARRAY,ORERR,PARAM,ENT,Y
W !,"Clear InfoPanel size & position settings for selected user -"
S DIC=200,DIC(0)="AEMQ" D ^DIC Q:Y<1
S ENT=+Y_";VA(200,"
S DIR(0)="Y",DIR("A")="Clear sizes for "_$P(Y,U,2),DIR("B")="YES"
D ^DIR Q:Y'=1
S PARAM="ORWCH BOUNDS"
D GETLST^XPAR(.ORARRAY,ENT,PARAM,.ORERR) I ORERR W !,ORERR
S INST="",IDX=0 F S IDX=$O(ORARRAY(IDX)) Q:IDX'>0 D
.S NODE=$G(ORARRAY(IDX))
.I $P(NODE,U)["frmHTMLDialog"!($P(NODE,U)["TfrmPtInfoDetails") D
..K INST,ORERR S INST=$P(NODE,U)
..D DEL^XPAR(ENT,PARAM,INST,.ORERR) I ORERR W !,ORERR
W !,"Settings cleared."
Q
;
CODE(RESULTS,FILENUM,FLD) ;
N CNT,CONST,IDX,ORARRAY,PIECES,TITLE,TMP
D FIELD^DID(FILENUM,FLD,"","POINTER","ORARRAY")
S PIECES=$L($G(ORARRAY("POINTER")),";")
S CNT=0 F IDX=1:1:PIECES D
.S TMP=$P(ORARRAY("POINTER"),";",IDX)
.S CONST=$P(TMP,":"),TITLE=$P(TMP,":",2) Q:TMP="" Q:TITLE=""
.S CNT=CNT+1,RESULTS(CNT,"const")=CONST,RESULTS(CNT,"title")=TITLE
;S RESULTS(CNT,"const")="-1",RESULTS(CNT,"title")="null"
Q
;
GETNATIONAL() ;
Q +$O(^ORI(101.71,"B","NATIONAL",""))
;
;begin APIs for displaying an message when the panels are updated
GETUPDSTATUS() ;
Q +$G(^XTMP("ORI INFO PANELS UPDATING","STATUS"))
;
KILLNATIONAL ;
N DA,DIK
S DA=$$GETNATIONAL I DA=0 Q
S DIK="^ORI(101.71," D ^DIK
Q
;
KILLUPDATING ;
K ^XTMP("ORI INFO PANELS UPDATING")
Q
;
SETUPDATING ;
S ^XTMP("ORI INFO PANELS UPDATING",0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"CPRS Info Panels Updates"
S ^XTMP("ORI INFO PANELS UPDATING","STATUS")=1
Q
;end APIs for displaying an message when the panels are updated
;
CHKRTN(TAG,RTN) ; verify routine and tag entry point
N VAL,X S VAL=$G(TAG)_U_$G(RTN),X=RTN X ^%ZOSF("TEST")
Q:'$T "0^Routine ["_RTN_"] not found."
I $T(@VAL)="" Q "0^Tag ["_TAG_"] not present in "_RTN_"."
Q 1
;
PNLEXECODE(DA,DATA,DFN,NODE,NUM,SUB,CODE,FROM) ; get executable code from # 101.75
Q:'$G(CODE) 0
N IEN,INPUT,NODE0,RESULT,RTN,TAG S IEN=DA(0)_";"_DA(1)_";"_DA(2)_";"_DA(3),NODE0=$G(^OR(101.75,CODE,0))
S RTN=$P(NODE0,U,2),TAG=$P(NODE0,U,3),RESULT=$$CHKRTN(TAG,RTN) Q:'RESULT RESULT S RESULT=0
S INPUT("callFrom")=FROM,INPUT("panelIndex")=DA(0)_";"_DA(1)_";"_DA(2)_";"_DA(3),INPUT("patientId")=DFN,INPUT("subscript")=SUB
S RESULT=$$XECODE(TAG,RTN,.INPUT,.DATA,NUM,.RESULT,SUB) Q:'RESULT RESULT
N Num,X S Num=$O(DATA("presentation",NUM,"detailText","\",""),-1)+1
S X=0 F S X=$O(^TMP(SUB,$J,"CODE",IEN,X)) Q:'X S DATA("presentation",NUM,"detailText","\",X+Num)=^TMP(SUB,$J,"CODE",IEN,X)_$C(13)_$C(10)
Q RESULT
XECODE(TAG,RTN,INPUT,DATA,NUM,RESULT,SUB) ; execute code
N $ETRAP,$ESTACK S $ETRAP="D ERR^ORIUTL(TAG,RTN,.INPUT,.DATA,NUM,.RESULT,SUB)"
N XEC S XEC="S XEC=$$"_TAG_U_RTN_"(.INPUT)" X XEC
Q $S(+XEC:XEC,1:RESULT)
ERR(TAG,RTN,INPUT,DATA,NUM,RESULT,SUB) ; capture error data, add to detailText
N ECNT,ERR,Num S (ECNT,^TMP(SUB,$J,"detailText error",NUM))=$G(^TMP(SUB,$J,"detailText error",NUM))+1
S $ECODE="",ERR=$$EC^%ZOSV,Num=$O(DATA("presentation",NUM,"detailText","\",""),-1)+1
S DATA("presentation",NUM,"detailText","\",Num)="Code Execution Error ["_ECNT_"]"_$C(13)_$C(10)
N VAR S VAR="" F S VAR=$O(INPUT(VAR)) Q:VAR="" D
. S Num=$O(DATA("presentation",NUM,"detailText","\",""),-1)+1
. S DATA("presentation",NUM,"detailText","\",Num)=$$SETSTR(VAR_"="_INPUT(VAR),"",5,$L(VAR_"="_INPUT(VAR)))_$C(13)_$C(10)
S Num=$O(DATA("presentation",NUM,"detailText","\",""),-1)+1,DATA("presentation",NUM,"detailText","\",Num)=$$SETSTR(ERR,"",5,$L(ERR))_$C(13)_$C(10)
S DATA("presentation",NUM,"detailText","\",Num+1)=$C(13)_$C(10),RESULT=1 ; debugging use
Q
;
;
ONCLICKEXECODE(SUB,DFN,USER,TYPE,PIDX,MPFIEN,ADDREQDATA,CACHESUB) ;
N INPUTS,RTN,TAG,RESULT
S RTN=$P(^OR(101.75,MPFIEN,0),U,2),TAG=$P(^OR(101.75,MPFIEN,0),U,3)
S RESULT=$$CHKRTN(TAG,RTN) Q:'RESULT RESULT
S INPUTS("patientId")=DFN
S INPUTS("panelIndex")=PIDX
S INPUTS("user")=USER
S INPUTS("subscript")=SUB
I $G(CACHESUB)'="" S INPUTS("cacheSub")=CACHESUB
M INPUTS=ADDREQDATA
S INPUTS("callFrom")=$S(TYPE="ONCLICK":"panelOnClickEvent",TYPE="SAVE":"editorSave",TYPE="BUILD":"editorBuilder",TYPE="LOOKUP":"longListLookup")
N XEC S XEC="S XEC=$$"_TAG_U_RTN_"(.INPUTS)" X XEC
S RESULT=XEC
Q RESULT
;
SETSTR(S,V,X,L) Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
;
STRREP(STRING,TS,RS) ;Replace every occurrence of the target string (TS)
;in STRING with the replacement string (RS).
;Example 9.19 (page 220) in "The Complete Mumps" by John Lewkowicz:
; F Q:STRING'[TS S STRING=$P(STRING,TS)_RS_$P(STRING,TS,2,999)
;fails if any portion of the target string is contained in the with
;string. Therefore a more elaborate version is required.
;
N IND,NPCS,STR
I STRING'[TS Q STRING
;Count the number of pieces using the target string as the delimiter.
S NPCS=$L(STRING,TS)
;Extract the pieces and concatenate RS
S STR=""
F IND=1:1:NPCS-1 S STR=STR_$P(STRING,TS,IND)_RS
S STR=STR_$P(STRING,TS,NPCS)
Q STR
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORIUTL 5240 printed May 25, 2026@12:35:12 Page 2
ORIUTL ;X/AJB - PANELS UI UTILITIES ;Mar 24, 2025@13:14:52
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
+2 ;
+3 QUIT
+4 ;
CLEARSIZE ;
+1 NEW DIC,DIR,DIK,DIROUT,DIRUT,DTOUT,DUOUT
+2 NEW IDX,INST,NODE,ORARRAY,ORERR,PARAM,ENT,Y
+3 WRITE !,"Clear InfoPanel size & position settings for selected user -"
+4 SET DIC=200
SET DIC(0)="AEMQ"
DO ^DIC
if Y<1
QUIT
+5 SET ENT=+Y_";VA(200,"
+6 SET DIR(0)="Y"
SET DIR("A")="Clear sizes for "_$PIECE(Y,U,2)
SET DIR("B")="YES"
+7 DO ^DIR
if Y'=1
QUIT
+8 SET PARAM="ORWCH BOUNDS"
+9 DO GETLST^XPAR(.ORARRAY,ENT,PARAM,.ORERR)
IF ORERR
WRITE !,ORERR
+10 SET INST=""
SET IDX=0
FOR
SET IDX=$ORDER(ORARRAY(IDX))
if IDX'>0
QUIT
Begin DoDot:1
+11 SET NODE=$GET(ORARRAY(IDX))
+12 IF $PIECE(NODE,U)["frmHTMLDialog"!($PIECE(NODE,U)["TfrmPtInfoDetails")
Begin DoDot:2
+13 KILL INST,ORERR
SET INST=$PIECE(NODE,U)
+14 DO DEL^XPAR(ENT,PARAM,INST,.ORERR)
IF ORERR
WRITE !,ORERR
End DoDot:2
End DoDot:1
+15 WRITE !,"Settings cleared."
+16 QUIT
+17 ;
CODE(RESULTS,FILENUM,FLD) ;
+1 NEW CNT,CONST,IDX,ORARRAY,PIECES,TITLE,TMP
+2 DO FIELD^DID(FILENUM,FLD,"","POINTER","ORARRAY")
+3 SET PIECES=$LENGTH($GET(ORARRAY("POINTER")),";")
+4 SET CNT=0
FOR IDX=1:1:PIECES
Begin DoDot:1
+5 SET TMP=$PIECE(ORARRAY("POINTER"),";",IDX)
+6 SET CONST=$PIECE(TMP,":")
SET TITLE=$PIECE(TMP,":",2)
if TMP=""
QUIT
if TITLE=""
QUIT
+7 SET CNT=CNT+1
SET RESULTS(CNT,"const")=CONST
SET RESULTS(CNT,"title")=TITLE
End DoDot:1
+8 ;S RESULTS(CNT,"const")="-1",RESULTS(CNT,"title")="null"
+9 QUIT
+10 ;
GETNATIONAL() ;
+1 QUIT +$ORDER(^ORI(101.71,"B","NATIONAL",""))
+2 ;
+3 ;begin APIs for displaying an message when the panels are updated
GETUPDSTATUS() ;
+1 QUIT +$GET(^XTMP("ORI INFO PANELS UPDATING","STATUS"))
+2 ;
KILLNATIONAL ;
+1 NEW DA,DIK
+2 SET DA=$$GETNATIONAL
IF DA=0
QUIT
+3 SET DIK="^ORI(101.71,"
DO ^DIK
+4 QUIT
+5 ;
KILLUPDATING ;
+1 KILL ^XTMP("ORI INFO PANELS UPDATING")
+2 QUIT
+3 ;
SETUPDATING ;
+1 SET ^XTMP("ORI INFO PANELS UPDATING",0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"CPRS Info Panels Updates"
+2 SET ^XTMP("ORI INFO PANELS UPDATING","STATUS")=1
+3 QUIT
+4 ;end APIs for displaying an message when the panels are updated
+5 ;
CHKRTN(TAG,RTN) ; verify routine and tag entry point
+1 NEW VAL,X
SET VAL=$GET(TAG)_U_$GET(RTN)
SET X=RTN
XECUTE ^%ZOSF("TEST")
+2 if '$TEST
QUIT "0^Routine ["_RTN_"] not found."
+3 IF $TEXT(@VAL)=""
QUIT "0^Tag ["_TAG_"] not present in "_RTN_"."
+4 QUIT 1
+5 ;
PNLEXECODE(DA,DATA,DFN,NODE,NUM,SUB,CODE,FROM) ; get executable code from # 101.75
+1 if '$GET(CODE)
QUIT 0
+2 NEW IEN,INPUT,NODE0,RESULT,RTN,TAG
SET IEN=DA(0)_";"_DA(1)_";"_DA(2)_";"_DA(3)
SET NODE0=$GET(^OR(101.75,CODE,0))
+3 SET RTN=$PIECE(NODE0,U,2)
SET TAG=$PIECE(NODE0,U,3)
SET RESULT=$$CHKRTN(TAG,RTN)
if 'RESULT
QUIT RESULT
SET RESULT=0
+4 SET INPUT("callFrom")=FROM
SET INPUT("panelIndex")=DA(0)_";"_DA(1)_";"_DA(2)_";"_DA(3)
SET INPUT("patientId")=DFN
SET INPUT("subscript")=SUB
+5 SET RESULT=$$XECODE(TAG,RTN,.INPUT,.DATA,NUM,.RESULT,SUB)
if 'RESULT
QUIT RESULT
+6 NEW Num,X
SET Num=$ORDER(DATA("presentation",NUM,"detailText","\",""),-1)+1
+7 SET X=0
FOR
SET X=$ORDER(^TMP(SUB,$JOB,"CODE",IEN,X))
if 'X
QUIT
SET DATA("presentation",NUM,"detailText","\",X+Num)=^TMP(SUB,$JOB,"CODE",IEN,X)_$CHAR(13)_$CHAR(10)
+8 QUIT RESULT
XECODE(TAG,RTN,INPUT,DATA,NUM,RESULT,SUB) ; execute code
+1 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^ORIUTL(TAG,RTN,.INPUT,.DATA,NUM,.RESULT,SUB)"
+2 NEW XEC
SET XEC="S XEC=$$"_TAG_U_RTN_"(.INPUT)"
XECUTE XEC
+3 QUIT $SELECT(+XEC:XEC,1:RESULT)
ERR(TAG,RTN,INPUT,DATA,NUM,RESULT,SUB) ; capture error data, add to detailText
+1 NEW ECNT,ERR,Num
SET (ECNT,^TMP(SUB,$JOB,"detailText error",NUM))=$GET(^TMP(SUB,$JOB,"detailText error",NUM))+1
+2 SET $ECODE=""
SET ERR=$$EC^%ZOSV
SET Num=$ORDER(DATA("presentation",NUM,"detailText","\",""),-1)+1
+3 SET DATA("presentation",NUM,"detailText","\",Num)="Code Execution Error ["_ECNT_"]"_$CHAR(13)_$CHAR(10)
+4 NEW VAR
SET VAR=""
FOR
SET VAR=$ORDER(INPUT(VAR))
if VAR=""
QUIT
Begin DoDot:1
+5 SET Num=$ORDER(DATA("presentation",NUM,"detailText","\",""),-1)+1
+6 SET DATA("presentation",NUM,"detailText","\",Num)=$$SETSTR(VAR_"="_INPUT(VAR),"",5,$LENGTH(VAR_"="_INPUT(VAR)))_$CHAR(13)_$CHAR(10)
End DoDot:1
+7 SET Num=$ORDER(DATA("presentation",NUM,"detailText","\",""),-1)+1
SET DATA("presentation",NUM,"detailText","\",Num)=$$SETSTR(ERR,"",5,$LENGTH(ERR))_$CHAR(13)_$CHAR(10)
+8 ; debugging use
SET DATA("presentation",NUM,"detailText","\",Num+1)=$CHAR(13)_$CHAR(10)
SET RESULT=1
+9 QUIT
+10 ;
+11 ;
ONCLICKEXECODE(SUB,DFN,USER,TYPE,PIDX,MPFIEN,ADDREQDATA,CACHESUB) ;
+1 NEW INPUTS,RTN,TAG,RESULT
+2 SET RTN=$PIECE(^OR(101.75,MPFIEN,0),U,2)
SET TAG=$PIECE(^OR(101.75,MPFIEN,0),U,3)
+3 SET RESULT=$$CHKRTN(TAG,RTN)
if 'RESULT
QUIT RESULT
+4 SET INPUTS("patientId")=DFN
+5 SET INPUTS("panelIndex")=PIDX
+6 SET INPUTS("user")=USER
+7 SET INPUTS("subscript")=SUB
+8 IF $GET(CACHESUB)'=""
SET INPUTS("cacheSub")=CACHESUB
+9 MERGE INPUTS=ADDREQDATA
+10 SET INPUTS("callFrom")=$SELECT(TYPE="ONCLICK":"panelOnClickEvent",TYPE="SAVE":"editorSave",TYPE="BUILD":"editorBuilder",TYPE="LOOKUP":"longListLookup")
+11 NEW XEC
SET XEC="S XEC=$$"_TAG_U_RTN_"(.INPUTS)"
XECUTE XEC
+12 SET RESULT=XEC
+13 QUIT RESULT
+14 ;
SETSTR(S,V,X,L) QUIT $EXTRACT(V_$JUSTIFY("",X-1),1,X-1)_$EXTRACT(S_$JUSTIFY("",L),1,L)_$EXTRACT(V,X+L,999)
+1 ;
STRREP(STRING,TS,RS) ;Replace every occurrence of the target string (TS)
+1 ;in STRING with the replacement string (RS).
+2 ;Example 9.19 (page 220) in "The Complete Mumps" by John Lewkowicz:
+3 ; F Q:STRING'[TS S STRING=$P(STRING,TS)_RS_$P(STRING,TS,2,999)
+4 ;fails if any portion of the target string is contained in the with
+5 ;string. Therefore a more elaborate version is required.
+6 ;
+7 NEW IND,NPCS,STR
+8 IF STRING'[TS
QUIT STRING
+9 ;Count the number of pieces using the target string as the delimiter.
+10 SET NPCS=$LENGTH(STRING,TS)
+11 ;Extract the pieces and concatenate RS
+12 SET STR=""
+13 FOR IND=1:1:NPCS-1
SET STR=STR_$PIECE(STRING,TS,IND)_RS
+14 SET STR=STR_$PIECE(STRING,TS,NPCS)
+15 QUIT STR
+16 ;
