ECUURPC ;ALB/JAM - Event Capture Data Entry Broker Utilities ;Jul 27, 2023@18:54:35
;;2.0;EVENT CAPTURE;**25,42,49,94,95,76,104,124,139,145,152,156,158,161,159,164,165,169**;8 May 96;Build 1
;
; Reference to $$CODEN^ICDEX in ICR #5747
; Reference to ^DIC in ICR #10006
; Reference to ^TMP supported by SACC 2.3.2.5.1
; Reference to ^%DT in ICR #10003
; Reference to FIND()^DIC in ICR #2051
; Reference to D^DIQ in ICR #10004
; Reference to DEVICE^ORWU in ICR #1837
; Reference to $$DT^XLFDT in ICR #10103
; Reference to $$PATCH^XPDUTL in ICR #10141
;
ECHELP(RESULTS,ECARY) ;
;
;Broker call returns the entries from HELP FILE #9.2
; RPC: EC GETSCNHELP
;INPUTS ECARY - Contains the following elements
; HLPDA - Help Frame Name
;
;OUTPUTS RESULTS - Array of help text in the HELP FRAM File (#9.2)
;
N HLPDA,DIC,X,Y
S HLPDA=$G(ECARY) I HLPDA="" Q
D SETENV^ECUMRPC K ^TMP($J,"ECHELP")
S DIC="^DIC(9.2,",DIC(0)="MN",X=HLPDA
D ^DIC M ^TMP($J,"ECHELP")=^DIC(9.2,+Y,1)
I $D(^TMP($J,"ECHELP")) D
. S $P(^TMP($J,"ECHELP",0),U)=$P(^DIC(9.2,+Y,0),U,2)
S RESULTS=$NA(^TMP($J,"ECHELP"))
Q
FNDIEN(RESULTS,ECARY) ;find IEN
;Broker call returns the IEN from a file
; RPC: EC GETIEN
;INPUTS ECARY - Contains the following data elements
; FIL - File number
; TXT - .01 description
;
;OUTPUTS RESULTS - File IEN
;
N TXT,FIL,DIC,X,Y
D SETENV^ECUMRPC
S FIL=$P(ECARY,U),TXT=$P(ECARY,U,2) I TXT=""!(FIL="") Q
; For lookups on #80, use approved API
I FIL=80 S RESULTS=+$$CODEN^ICDEX(TXT,80) Q
;
S DIC=FIL,DIC(0)="MN",X=TXT
I FIL=81.3 S DIC("S")="I +$P($$MOD^ICPTMOD(Y,""I""),U,7)=1"
D ^DIC I Y=-1 Q
S RESULTS=+Y
Q
ECDATE(RESULTS,ECARY) ;
;
;Broker call returns an Fileman internal date
; RPC: EC GETDATE
;INPUTS ECARY - Contains the following elements
; DTSTR - Date String
; FLG - Date Flag (optional) Set to R if time is required
; FUT - Future Flag (optional) Set to F to allow date/times through
; midnight today
;
;OUTPUTS RESULTS - A valid Fileman date format^External format
;
N ECDTSTR,DIC,X,Y,DTSTR,FLG,FUT ;145
D SETENV^ECUMRPC
S DTSTR=$P(ECARY,U),FLG=$P(ECARY,U,2),FUT=$P(ECARY,U,3) I DTSTR="" Q ;145
S X=DTSTR,%DT="XT"_$S(FLG="R":"R",1:""),%DT(0)=$S(FUT="F":"-"_$$DT^XLFDT_.24,1:"-NOW") D ^%DT ;145 Set latest date/time allowed
I +Y<1 S RESULTS="0^Invalid Date/Time" Q
S RESULTS=Y D D^DIQ
S RESULTS=RESULTS_U_Y
Q
PATCH(RESULTS,ECARY) ;
;
;Broker call returns 1 if patch X is installed
; RPC: EC GETPATCH
;INPUTS ECARY - contains the patch number
;
;OUTPUTS RESULTS 1 OR 0
;
I ECARY="" Q
D SETENV^ECUMRPC
S RESULTS=$$PATCH^XPDUTL(ECARY)
Q
VERSRV(RESULTS,ECARY,VERSION) ; Return server version of option name and
; minimum GUI client version.
;
;Server/client version consist of 4 pieces, namely
; major version.minor version.release.build (ex. 2.0.10.1)
;
;Broker call returns server version of option name
; RPC: EC GETVERSION
;INPUTS ECARY - contains the option name
; VERSION - EC GUI client version ;stay in partition for session
;
;OUTPUTS RESULTS version number OR null ("")
; current server version^minimum client version
;
S ECCLVER=$G(VERSION)
I $G(ECARY)="" Q
N ECLST,ECMINV
S ECMINV="2.12.1.0" ;139,145 Minimum version of EC GUI client - 152:2.7,156:2.8,158:2.9,161:2.10,159:2.11,164:2.11.1
D FIND^DIC(19,"",1,"X",ECARY,1,,,,"ECLST")
I 'ECLST("DILIST",0) S RESULTS="" Q
S RESULTS=ECLST("DILIST","ID",1,1)
S RESULTS=$P(RESULTS,"version ",2)_U_ECMINV
Q
;
ECDEVICE(Y,FROM) ; Return a subset of entries from the Device file.
; .LST(n)=IEN;Name^DisplayName^Location^RMar^PLen
; FROM=text to $O from, DIR=$O direction
N I,IEN,CNT,SHOW,X,SAVFROM,TEMPY
S DIR=$P(FROM,U,2),FROM=$P(FROM,U)
I DIR="" S DIR=1
S SAVFROM=FROM
D DEVICE^ORWU(.Y,FROM,DIR)
M TEMPY=Y
S FROM=SAVFROM
D ECPREDEV(FROM,.Y) ;Get the information for the last printer selected
F I=1:1:19 S Y(I+1)=TEMPY(I)
Q
;
ECPREDEV(FROM,Y) ;This code was based off DEVICE^ORWU
N X0,X1,X90,X91,X95,IEN ;,XTYPE,XSTYPE,XTIME,ORA,ORPX,POP
N FOUND,SAVFROM,TMPSHOW
S SAVFROM=FROM
S FOUND="",IEN=0
I FROM["<" D Q
.S FOUND=1
.S FROM=$RE($P($RE(FROM),"< ",2)),IEN=$O(^%ZIS(1,"B",FROM,0))
.S X0=$G(^%ZIS(1,IEN,0)),X1=$G(^(1)),X90=$G(^(90)),X91=$G(^(91)),X95=$G(^(95))
.S SHOW=$P(X0,U) I SHOW'=FROM S SHOW=FROM_" <"_SHOW_">"
.S Y(1)=IEN_";"_$P(X0,U)_U_SHOW_U_$P(X1,U)_U_$P(X91,U)_U_$P(X91,U,3)
F S FROM=$O(^%ZIS(1,"B",FROM),-1) Q:FOUND D
.S IEN=$O(^%ZIS(1,"B",FROM,""),-1)
.S X0=$G(^%ZIS(1,IEN,0)),X1=$G(^(1)),X90=$G(^(90)),X91=$G(^(91)),X95=$G(^(95))
.S SHOW=$P(X0,U) I SHOW'=FROM S SHOW=FROM_" <"_SHOW_">"
.S TMPSHOW=SHOW_" "_$P(X91,U)
.I $E(TMPSHOW,1,$L(TMPSHOW)-1)=$E(SAVFROM,1,$L(SAVFROM)-2) S FOUND=1
S Y(1)=IEN_";"_$P(X0,U)_U_SHOW_U_$P(X1,U)_U_$P(X91,U)_U_$P(X91,U,3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUURPC 5046 printed Nov 22, 2024@17:09:25 Page 2
ECUURPC ;ALB/JAM - Event Capture Data Entry Broker Utilities ;Jul 27, 2023@18:54:35
+1 ;;2.0;EVENT CAPTURE;**25,42,49,94,95,76,104,124,139,145,152,156,158,161,159,164,165,169**;8 May 96;Build 1
+2 ;
+3 ; Reference to $$CODEN^ICDEX in ICR #5747
+4 ; Reference to ^DIC in ICR #10006
+5 ; Reference to ^TMP supported by SACC 2.3.2.5.1
+6 ; Reference to ^%DT in ICR #10003
+7 ; Reference to FIND()^DIC in ICR #2051
+8 ; Reference to D^DIQ in ICR #10004
+9 ; Reference to DEVICE^ORWU in ICR #1837
+10 ; Reference to $$DT^XLFDT in ICR #10103
+11 ; Reference to $$PATCH^XPDUTL in ICR #10141
+12 ;
ECHELP(RESULTS,ECARY) ;
+1 ;
+2 ;Broker call returns the entries from HELP FILE #9.2
+3 ; RPC: EC GETSCNHELP
+4 ;INPUTS ECARY - Contains the following elements
+5 ; HLPDA - Help Frame Name
+6 ;
+7 ;OUTPUTS RESULTS - Array of help text in the HELP FRAM File (#9.2)
+8 ;
+9 NEW HLPDA,DIC,X,Y
+10 SET HLPDA=$GET(ECARY)
IF HLPDA=""
QUIT
+11 DO SETENV^ECUMRPC
KILL ^TMP($JOB,"ECHELP")
+12 SET DIC="^DIC(9.2,"
SET DIC(0)="MN"
SET X=HLPDA
+13 DO ^DIC
MERGE ^TMP($JOB,"ECHELP")=^DIC(9.2,+Y,1)
+14 IF $DATA(^TMP($JOB,"ECHELP"))
Begin DoDot:1
+15 SET $PIECE(^TMP($JOB,"ECHELP",0),U)=$PIECE(^DIC(9.2,+Y,0),U,2)
End DoDot:1
+16 SET RESULTS=$NAME(^TMP($JOB,"ECHELP"))
+17 QUIT
FNDIEN(RESULTS,ECARY) ;find IEN
+1 ;Broker call returns the IEN from a file
+2 ; RPC: EC GETIEN
+3 ;INPUTS ECARY - Contains the following data elements
+4 ; FIL - File number
+5 ; TXT - .01 description
+6 ;
+7 ;OUTPUTS RESULTS - File IEN
+8 ;
+9 NEW TXT,FIL,DIC,X,Y
+10 DO SETENV^ECUMRPC
+11 SET FIL=$PIECE(ECARY,U)
SET TXT=$PIECE(ECARY,U,2)
IF TXT=""!(FIL="")
QUIT
+12 ; For lookups on #80, use approved API
+13 IF FIL=80
SET RESULTS=+$$CODEN^ICDEX(TXT,80)
QUIT
+14 ;
+15 SET DIC=FIL
SET DIC(0)="MN"
SET X=TXT
+16 IF FIL=81.3
SET DIC("S")="I +$P($$MOD^ICPTMOD(Y,""I""),U,7)=1"
+17 DO ^DIC
IF Y=-1
QUIT
+18 SET RESULTS=+Y
+19 QUIT
ECDATE(RESULTS,ECARY) ;
+1 ;
+2 ;Broker call returns an Fileman internal date
+3 ; RPC: EC GETDATE
+4 ;INPUTS ECARY - Contains the following elements
+5 ; DTSTR - Date String
+6 ; FLG - Date Flag (optional) Set to R if time is required
+7 ; FUT - Future Flag (optional) Set to F to allow date/times through
+8 ; midnight today
+9 ;
+10 ;OUTPUTS RESULTS - A valid Fileman date format^External format
+11 ;
+12 ;145
NEW ECDTSTR,DIC,X,Y,DTSTR,FLG,FUT
+13 DO SETENV^ECUMRPC
+14 ;145
SET DTSTR=$PIECE(ECARY,U)
SET FLG=$PIECE(ECARY,U,2)
SET FUT=$PIECE(ECARY,U,3)
IF DTSTR=""
QUIT
+15 ;145 Set latest date/time allowed
SET X=DTSTR
SET %DT="XT"_$SELECT(FLG="R":"R",1:"")
SET %DT(0)=$SELECT(FUT="F":"-"_$$DT^XLFDT_.24,1:"-NOW")
DO ^%DT
+16 IF +Y<1
SET RESULTS="0^Invalid Date/Time"
QUIT
+17 SET RESULTS=Y
DO D^DIQ
+18 SET RESULTS=RESULTS_U_Y
+19 QUIT
PATCH(RESULTS,ECARY) ;
+1 ;
+2 ;Broker call returns 1 if patch X is installed
+3 ; RPC: EC GETPATCH
+4 ;INPUTS ECARY - contains the patch number
+5 ;
+6 ;OUTPUTS RESULTS 1 OR 0
+7 ;
+8 IF ECARY=""
QUIT
+9 DO SETENV^ECUMRPC
+10 SET RESULTS=$$PATCH^XPDUTL(ECARY)
+11 QUIT
VERSRV(RESULTS,ECARY,VERSION) ; Return server version of option name and
+1 ; minimum GUI client version.
+2 ;
+3 ;Server/client version consist of 4 pieces, namely
+4 ; major version.minor version.release.build (ex. 2.0.10.1)
+5 ;
+6 ;Broker call returns server version of option name
+7 ; RPC: EC GETVERSION
+8 ;INPUTS ECARY - contains the option name
+9 ; VERSION - EC GUI client version ;stay in partition for session
+10 ;
+11 ;OUTPUTS RESULTS version number OR null ("")
+12 ; current server version^minimum client version
+13 ;
+14 SET ECCLVER=$GET(VERSION)
+15 IF $GET(ECARY)=""
QUIT
+16 NEW ECLST,ECMINV
+17 ;139,145 Minimum version of EC GUI client - 152:2.7,156:2.8,158:2.9,161:2.10,159:2.11,164:2.11.1
SET ECMINV="2.12.1.0"
+18 DO FIND^DIC(19,"",1,"X",ECARY,1,,,,"ECLST")
+19 IF 'ECLST("DILIST",0)
SET RESULTS=""
QUIT
+20 SET RESULTS=ECLST("DILIST","ID",1,1)
+21 SET RESULTS=$PIECE(RESULTS,"version ",2)_U_ECMINV
+22 QUIT
+23 ;
ECDEVICE(Y,FROM) ; Return a subset of entries from the Device file.
+1 ; .LST(n)=IEN;Name^DisplayName^Location^RMar^PLen
+2 ; FROM=text to $O from, DIR=$O direction
+3 NEW I,IEN,CNT,SHOW,X,SAVFROM,TEMPY
+4 SET DIR=$PIECE(FROM,U,2)
SET FROM=$PIECE(FROM,U)
+5 IF DIR=""
SET DIR=1
+6 SET SAVFROM=FROM
+7 DO DEVICE^ORWU(.Y,FROM,DIR)
+8 MERGE TEMPY=Y
+9 SET FROM=SAVFROM
+10 ;Get the information for the last printer selected
DO ECPREDEV(FROM,.Y)
+11 FOR I=1:1:19
SET Y(I+1)=TEMPY(I)
+12 QUIT
+13 ;
ECPREDEV(FROM,Y) ;This code was based off DEVICE^ORWU
+1 ;,XTYPE,XSTYPE,XTIME,ORA,ORPX,POP
NEW X0,X1,X90,X91,X95,IEN
+2 NEW FOUND,SAVFROM,TMPSHOW
+3 SET SAVFROM=FROM
+4 SET FOUND=""
SET IEN=0
+5 IF FROM["<"
Begin DoDot:1
+6 SET FOUND=1
+7 SET FROM=$REVERSE($PIECE($REVERSE(FROM),"< ",2))
SET IEN=$ORDER(^%ZIS(1,"B",FROM,0))
+8 SET X0=$GET(^%ZIS(1,IEN,0))
SET X1=$GET(^(1))
SET X90=$GET(^(90))
SET X91=$GET(^(91))
SET X95=$GET(^(95))
+9 SET SHOW=$PIECE(X0,U)
IF SHOW'=FROM
SET SHOW=FROM_" <"_SHOW_">"
+10 SET Y(1)=IEN_";"_$PIECE(X0,U)_U_SHOW_U_$PIECE(X1,U)_U_$PIECE(X91,U)_U_$PIECE(X91,U,3)
End DoDot:1
QUIT
+11 FOR
SET FROM=$ORDER(^%ZIS(1,"B",FROM),-1)
if FOUND
QUIT
Begin DoDot:1
+12 SET IEN=$ORDER(^%ZIS(1,"B",FROM,""),-1)
+13 SET X0=$GET(^%ZIS(1,IEN,0))
SET X1=$GET(^(1))
SET X90=$GET(^(90))
SET X91=$GET(^(91))
SET X95=$GET(^(95))
+14 SET SHOW=$PIECE(X0,U)
IF SHOW'=FROM
SET SHOW=FROM_" <"_SHOW_">"
+15 SET TMPSHOW=SHOW_" "_$PIECE(X91,U)
+16 IF $EXTRACT(TMPSHOW,1,$LENGTH(TMPSHOW)-1)=$EXTRACT(SAVFROM,1,$LENGTH(SAVFROM)-2)
SET FOUND=1
End DoDot:1
+17 SET Y(1)=IEN_";"_$PIECE(X0,U)_U_SHOW_U_$PIECE(X1,U)_U_$PIECE(X91,U)_U_$PIECE(X91,U,3)
+18 QUIT
