ORWU ;SLC/KCM - GENERAL UTILITIES FOR WINDOWS CALLS ;Dec 4, 2023@14:09
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,148,149,187,195,215,243,350,424,377,519,539,405,596,588,608**;Dec 17, 1997;Build 15
;
; Reference to ^%ZIS(1 supported by IA #2963
; Reference to ^%ZIS(2 supported by IA #2964
; Reference to ^DIC(3.1 supported by IA #1234
; Reference to ^SC supported by IA #10040
; Reference to ^VA(200 supported by IA #10060
; Reference to ^XUSEC( supported by IA #10076
; Reference to ^%DT supported by IA #10003
; Reference to WIN^DGPMDDCF supported by IA #1246
; Reference to FIND^DIC supported by IA #2051
; Reference to ^DID IN ICR #2052
; Reference to ^DILFD supported by IA #2055
; Reference to $$SITE^VASITE supported by IA #10112
; Reference to ^XLFJSON supported by IA #6682
; Reference to ^XLFSTR supported by IA #10104
; Reference to ^XPAR supported by IA #2263
; Reference to ^XPDUTL supported by IA #10141
; Reference to ^XQCHK supported by IA #10078
; Reference to $$KSP^XUPARAM supported by IA #2541
; Reference to $$PROD^XUPROD supported by IA #4440
; Reference to ^XUSHSHP supported by IA #10045
; Reference to $$DECRYP^XUSRB supported by IA #12241
;
Q
DT(Y,X,%DT) ; Internal Fileman Date/Time
; change the '00:00' that could be passed so Fileman doesn't reject
I $L($P(X,"@",2)),("00000000"[$TR($P(X,"@",2),":","")) S $P(X,"@",2)="00:00:01"
S %DT=$G(%DT,"TS") D ^%DT K %DT
Q
VALDT(Y,X,%DT) ; Validate date/time
S:'$D(%DT) %DT="TX" D ^%DT
Q
USERINFO(REC) ; Relevant info for current user
; return DUZ^NAME^USRCLS^CANSIGN^ISPROVIDER^ORDERROLE^NOORDER^DTIME^
; COUNTDOWN^ENABLEVERIFY^NOTIFYAPPS^MSGHANG^DOMAIN^SERVICE^
; AUTOSAVE^INITTAB^LASTTAB^WEBACCESS^ALLOWHOLD^ISRPL^RPLLIST^
; CORTABS^RPTTAB^STANUM^GECSTATUS^PRODACCT^^JOB NUMBER^EVALREMONDIALOG
N X,ORRPL,ORRPL1,ORRPL2,ORTAB,CORTABS,RPTTAB,ORDT,OREFF,OREXP,ORDATEOK
S REC=DUZ_U_$P(^VA(200,DUZ,0),U)
S $P(REC,U,3)=$S($D(^XUSEC("ORES",DUZ)):3,$D(^XUSEC("ORELSE",DUZ)):2,$D(^XUSEC("OREMAS",DUZ)):1,1:0)
S $P(REC,U,4)=$D(^XUSEC("ORES",DUZ))&$D(^XUSEC("PROVIDER",DUZ))
S $P(REC,U,5)=$D(^XUSEC("PROVIDER",DUZ))
S $P(REC,U,6)=$$ORDROLE
S $P(REC,U,7)=$$GET^XPAR("USR^SYS^PKG","ORWOR DISABLE ORDERING",1,"I")
S $P(REC,U,8)=$$GET^XPAR("USR^SYS","ORWOR TIMEOUT CHART",1,"I")
I '$P(REC,U,8),$G(DTIME) S $P(REC,U,8)=DTIME
S $P(REC,U,9)=$$GET^XPAR("USR^SYS^PKG","ORWOR TIMEOUT COUNTDOWN",1,"I")
S X=$$GET^XPAR("USR^SYS^PKG","ORWOR ENABLE VERIFY",1,"I")
S $P(REC,U,10)=$S(X=1:1,X=2:0,1:'$P(REC,U,7))
S $P(REC,U,11)=$$GET^XPAR("USR^SYS^PKG","ORWOR BROADCAST MESSAGES",1,"I")
S $P(REC,U,12)=$$GET^XPAR("USR^SYS^PKG","ORWOR AUTO CLOSE PT MSG",1,"I")
S $P(REC,U,13)=$$KSP^XUPARAM("WHERE") ; domain
S $P(REC,U,14)=+$G(^VA(200,DUZ,5)) ; service/section
S $P(REC,U,15)=$$GET^XPAR("USR^SYS^PKG","ORWOR AUTOSAVE NOTE",1,"I")
S $P(REC,U,16)=$$GET^XPAR("USR^DIV^SYS^PKG","ORCH INITIAL TAB",1,"I")
S $P(REC,U,17)=$$GET^XPAR("USR^DIV^SYS^PKG","ORCH USE LAST TAB",1,"I")
S $P(REC,U,18)=$$GET^XPAR("USR^DIV^SYS^PKG","ORWOR DISABLE WEB ACCESS",1,"I")
S $P(REC,U,19)=$$GET^XPAR("SYS^PKG","ORWOR DISABLE HOLD ORDERS",1,"I")
; 2 pieces added by PKS on 11/5/2001 for "Reports Only:"
; IA# 10060 allows read access to ^VA(200 file.
S ORRPL=$G(^VA(200,DUZ,101)) ; RPL node.
S ORRPL1=$P(ORRPL,U)
S $P(REC,U,20)=ORRPL1 ; ISRPL piece.
S ORRPL2=$P(ORRPL,U,2)
S $P(REC,U,21)=ORRPL2 ; RPLLIST piece.
;
; Additional pieces for CPRS tabs access:
; IA# 10060 allows read access to ^VA(200.01013 multiple.
S ORDT=DT ; Today.
S (CORTABS,RPTTAB)=0
S ORRPL=0
F S ORRPL=$O(^VA(200,DUZ,"ORD",ORRPL)) Q:ORRPL<1 D
.S ORTAB=$G(^VA(200,DUZ,"ORD",ORRPL,0))
.I ORTAB="" Q
.S OREFF=$P(ORTAB,U,2)
.S OREXP=$P(ORTAB,U,3)
.S ORTAB=$P(ORTAB,U)
.I ORTAB="" Q
.S ORTAB=$G(^ORD(101.13,ORTAB,0))
.I ORTAB="" Q
.S ORTAB=$P(ORTAB,U)
.I ORTAB="" Q
.S ORTAB=$$UP^XLFSTR(ORTAB)
.S ORDATEOK=1 ; Default.
.I ((OREFF="")!(OREFF>ORDT)) S ORDATEOK=0 ; Eff. date NG.
.I ORDATEOK D
..I OREXP="" Q ; No exp. date.
..I (OREXP<ORDT) S ORDATEOK=0 ; Exp. date NG.
..I (OREXP=ORDT) S ORDATEOK=0 ; Exp. date NG.
.;
.; Set TRUE if OK:
.I ((ORTAB="COR")&(ORDATEOK)) S CORTABS=1
.I ((ORTAB="RPT")&(ORDATEOK)) S RPTTAB=1
;
; When done, set all valid tabs for access:
S $P(REC,U,22)=CORTABS ; "Core" tabs.
S $P(REC,U,23)=RPTTAB ; "Reports" tab.
;
S $P(REC,U,24)=$P($$SITE^VASITE,U,3)
S $P(REC,U,25)=$$GET^XPAR("USR^TEA","PXRM GEC STATUS CHECK",1,"I")
S $P(REC,U,26)=$$PROD^XUPROD
S $P(REC,U,27)=$$GET^XPAR("ALL","OR ONE STEP CLINIC ADMIN OFF",1,"I")
S $P(REC,U,28)=$J
S $P(REC,U,29)=+$$GET^XPAR("USR^SYS","PXRM DIALOG EVAL DEFINITION",1,"I")
Q
;
HASKEY(VAL,KEY) ; returns TRUE if the user possesses the security key
S VAL=''$D(^XUSEC(KEY,DUZ))
Q
HASOPTN(VAL,OPTION) ; returns TRUE if the user has access to a menu option
S VAL=+$$ACCESS^XQCHK(DUZ,OPTION)
I VAL'>0 S VAL=0
E S VAL=1
Q
NPHASKEY(VAL,NP,KEY) ; returns TRUE if the person has the security key
S VAL=''$D(^XUSEC(KEY,NP))
Q
ORDROLE() ; returns the role a person takes in ordering
; VAL: 0=nokey, 1=clerk, 2=nurse, 3=physician, 4=student, 5=bad keys
;I '$G(ORWCLVER) Q 0 ; version of client is too old for ordering
I ($D(^XUSEC("OREMAS",DUZ))+$D(^XUSEC("ORELSE",DUZ))+$D(^XUSEC("ORES",DUZ)))>1 Q 5
I $D(^XUSEC("OREMAS",DUZ)) Q 1 ; clerk
I $D(^XUSEC("ORELSE",DUZ)) Q 2 ; nurse
I $D(^XUSEC("ORES",DUZ)),$D(^XUSEC("PROVIDER",DUZ)) Q 3 ; doctor
I $D(^XUSEC("PROVIDER",DUZ)) Q 4 ; student
Q 0
VALIDSIG(ESOK,X) ; returns TRUE if valid electronic signature
S X=$$DECRYP^XUSRB1(X),ESOK=0 ; network encrypted
D HASH^XUSHSHP
I X=$P($G(^VA(200,+DUZ,20)),U,4) S ESOK=1
Q
N ANENT,ORTLST,ORT,ORCNT
S ANENT="PKG"
D GETLST^XPAR(.ORLST,ANENT,"ORWT TOOLS MENU","N")
S ANENT="ALL^"_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
S ORCNT=$O(ORLST(""),-1)
D GETLST^XPAR(.ORTLST,ANENT,"ORWT TOOLS MENU","N")
S ORT=0 F S ORT=$O(ORTLST(ORT)) Q:'ORT D
. S ORCNT=ORCNT+1
. S ORLST(ORCNT)=ORTLST(ORT)
Q
ACTLOC(LOC) ; Function: returns TRUE if active hospital location
; IA# 10040.
N D0,X I +$G(^SC(LOC,"OOS")) Q 0 ; screen out OOS entry
S D0=+$G(^SC(LOC,42)) I D0 D WIN^DGPMDDCF Q 'X ; chk out of svc wards
S X=$G(^SC(LOC,"I")) I +X=0 Q 1 ; no inactivate date
I DT>$P(X,U)&($P(X,U,2)=""!(DT<$P(X,U,2))) Q 0 ; chk reactivate date
Q 1 ; must still be active
;
CLINLOC(Y,FROM,DIR) ; Return a set of clinics from HOSPITAL LOCATION
; .Y=returned list, FROM=text to $O from, DIR=$O direction,
N I,IEN,CNT S I=0,CNT=44
F Q:I'<CNT S FROM=$O(^SC("B",FROM),DIR) Q:FROM="" D ; IA# 10040.
. S IEN="" F S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN D
. . I ($P($G(^SC(IEN,0)),U,3)'="C")!('$$ACTLOC(IEN)) Q
. . S I=I+1,Y(I)=IEN_"^"_FROM
Q
INPLOC(Y,FROM,DIR) ;Return a set of wards from HOSPITAL LOCATION
; .Y=returned list, FROM=text to $O from, DIR=$O direction,
N I,IEN,CNT S I=0,CNT=44
F Q:I'<CNT S FROM=$O(^SC("B",FROM),DIR) Q:FROM="" D ; IA# 10040.
. S IEN="" F S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN D
. . I ($P($G(^SC(IEN,0)),U,3)'="W") Q
. . I '$$ACTLOC(IEN) Q
. . S I=I+1,Y(I)=IEN_"^"_FROM
Q
HOSPLOC(Y,FROM,DIR) ; Return a set of locations from HOSPITAL LOCATION
; .Y=returned list, FROM=text to $O from, DIR=$O direction,
N I,IEN,CNT S I=0,CNT=44
F Q:I'<CNT S FROM=$O(^SC("B",FROM),DIR) Q:FROM="" D ; IA# 10040.
. S IEN="" F S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN D
. . Q:("CW"'[$P($G(^SC(IEN,0)),U,3)!('$$ACTLOC(IEN)))
. . S I=I+1,Y(I)=IEN_"^"_FROM
Q
NEWPERS(ORY,ORFROM,ORDIR,ORKEY,ORDATE,ORVIZ,ORALL,ORPDMP,ORSIM,OREXCLDE,ORNVA) ; Return a set of names from the NEW PERSON file.
S OREXCLDE=$G(OREXCLDE,0) ; DEFAULT value is OFF - exclude users in the user class set in OR CPRS USER CLASS EXCLUDE (additional signers only)
S ORNVA=$G(ORNVA,1) ; DEFAULT is ON - include Non-VA providers
; * ajb
I $$GET^XPAR("SYS","ORNEWPERS ACTIVE") D Q ; use new entry point^routine only if value is YES (default is YES)
. N I,PARAMS,PRM S PARAMS("HELP")=0,PRM(0)="FROM^DIR^KEY^DATE^RDV^ALL^PDMP^SPN^EXC^NVAP"
. S PRM=$P($P($P($T(NEWPERS),"(",2),")"),",",2,$L($P($P($T(NEWPERS),"(",2),")"))) ; set string of parameters from NEWPERS
. F I=1:1:$L(PRM,",") S PARAMS($P(PRM(0),U,I))=$G(@($P(PRM,",",I))) ; set variables to pass by reference
. D NEWPERSON^ORNEWPERS(.ORY,.PARAMS)
; * ajb
; SLC/PKS: Code moved to ORWU1 on 12/3/2002.
; ORPDMP - filter users that are authorized to make a PDMP query (p519)
D NP1^ORWU1
Q
GBLREF(VAL,FN) ; return global reference for file number
S VAL="" Q:'FN
S VAL=$$ROOT^DILFD(+FN)
; I $E($RE(VAL))="," S VAL=$E(VAL,1,$L(VAL)-1)_")"
; I $E($RE(VAL))="(" S VAL=$P(VAL,"(",1)
Q
GENERIC(Y,FROM,DIR,REF) ; Return a set of entries from xref in REF
; .Y=returned list, FROM=text to $O from, DIR=$O direction,
N I,IEN,CNT S I=0,CNT=44
F Q:I'<CNT S FROM=$O(@REF@(FROM),DIR) Q:FROM="" D
. S IEN="" F S IEN=$O(@REF@(FROM,IEN),DIR) Q:'IEN D
. . S I=I+1,Y(I)=IEN_"^"_FROM
Q
EXTNAME(VAL,IEN,FN) ; return external form of pointer
; IEN=internal number, FN=file number
N REF S REF=$G(^DIC(FN,0,"GL")),VAL=""
I $L(REF),+IEN S VAL=$P($G(@(REF_IEN_",0)")),U)
Q
PARAM(VAL,APARAM) ; return a parameter value for a user
; call assumes current user, default entities, single instance
S VAL=$$GET^XPAR("ALL",APARAM,1,"I")
Q
PARAMS(ORLIST,APARAM) ; return a list of parameter values
; call assumes current user, default entities, multiple instances
D GETLST^XPAR(.ORLIST,"ALL",APARAM,"Q")
Q
DEVICE(Y,FROM,DIR) ; 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 S I=0,CNT=20
I FROM["<" S FROM=$RE($P($RE(FROM),"< ",2))
F Q:I'<CNT S FROM=$O(^%ZIS(1,"B",FROM),DIR) Q:FROM="" D
. S IEN=0 F S IEN=$O(^%ZIS(1,"B",FROM,IEN)) Q:'IEN D
.. N X0,X1,X90,X91,X95,XTYPE,XSTYPE,XTIME,ORA,ORPX,POP,ORPCNT
.. Q:'$D(^%ZIS(1,IEN,0)) S X0=^(0),X1=$G(^(1)),X90=$G(^(90)),X91=$G(^(91)),X95=$G(^(95)),XSTYPE=$G(^("SUBTYPE")),XTIME=$G(^("TIME")),XTYPE=$G(^("TYPE"))
.. I $E($G(^%ZIS(2,+XSTYPE,0)))'="P" Q ;Printers only
.. S X=$P(XTYPE,"^") I X'="TRM",X'="HG",X'="HFS",X'="CHAN" Q ;Device Types
.. S X=X0 I ($P(X,U,2)="0")!($P(X,U,12)=2) Q ;Queuing allowed
.. S X=+X90 I X,(X'>DT) Q ;Out of Service
.. I XTIME]"" S ORA=$P(XTIME,"^"),ORPX=$P($H,",",2),ORPCNT=ORPX\60#60+(ORPX\3600*100),ORPX=$P(ORA,"-",2) I ORPX'<ORA&(ORPCNT'>ORPX&(ORPCNT'<ORA))!(ORPX<ORA&(ORPCNT'<ORA!(ORPCNT'>ORPX))) Q ;Prohibited Times
.. S POP=0
.. I X95]"" S ORPX=$G(DUZ(0)) I ORPX'="@" S POP=1 F ORA=1:1:$L(ORPX) I X95[$E(ORPX,ORA) S POP=0 Q
.. Q:POP ;Security check
.. S SHOW=$P(X0,U) I SHOW'=FROM S SHOW=FROM_" <"_SHOW_">"
.. S I=I+1,Y(I)=IEN_";"_$P(X0,U)_U_SHOW_U_$P(X1,U)_U_$P(X91,U)_U_$P(X91,U,3)
Q
URGENCY(Y) ; -- retrieve set values from dd for discharge summary urgency
N ORDD,I,X
D FIELD^DID(8925,.09,"","POINTER","ORDD")
F I=1:1 S X=$P(ORDD("POINTER"),";",I) Q:X="" S Y(I)=$TR(X,":","^")
Q
PATCH(VAL,X) ; Return 1 if patch X is installed
S VAL=$$PATCH^XPDUTL(X)
Q
VERSION(VAL,X) ;Return version of package or namespace
S VAL=$$VERSION^XPDUTL(X)
Q
VERSRV(VAL,X,CLVER) ; Return server version of option name
S ORWCLVER=$G(CLVER) ; leave in partition for session
N BADVAL,ORLST
D FIND^DIC(19,"",1,"X",X,1,,,,"ORLST")
I 'ORLST("DILIST",0) S VAL="0.0.0.0" Q
S VAL=ORLST("DILIST","ID",1,1)
S VAL=$P(VAL,"version ",2)
S BADVAL=0
I $P(VAL,".",1)="" S BADVAL=1
I $P(VAL,".",2)="" S BADVAL=1
I $P(VAL,".",3)="" S BADVAL=1
I $P(VAL,".",4)="" S BADVAL=1
I ((BADVAL)!('VAL)!(VAL="")) S VAL="0.0.0.0"
Q
OVERDL(VAL) ;Return parameter value of ORPARAM OVER DATELINE
S VAL=$$GET^XPAR("ALL","ORPARAM OVER DATELINE")
Q
MOBAPP(VAL,ORAPP) ;set ^TMP($J,"OR MOB APP")
S ^TMP($J,"OR MOB APP")=ORAPP
S VAL=1
Q
;
JSYSPARM(RESULTS,USER) ;
N TEMP
S RESULTS=$NA(^TMP($J,"ORWU SYSPARAM"))
S TEMP("reEvaluateReminders")=+$$GET^XPAR("USR^SYS","PXRM DIALOG EVAL DEFINITION",1,"I")
D ;Copy/Paste Words to Count as a Copy
. N X
. D WRDCOPY^ORWTIU(.X,DUZ(2))
. S TEMP("cpWordCopy")=X
D ;Copy/Paste Percent to Identify a Paste Source
. N X
. D PCTCOPY^ORWTIU(.X,DUZ(2))
. S TEMP("cpPercentCopy")=X
D ;Copy/Paste Allowed to View Paste Information
. N X
. D VIEWCOPY^ORWTIU(.X,DUZ,0,DUZ(2))
. S TEMP("cpViewCopy")=X
D ;Copy/Paste Paste Identifiers
. N X
. D LDCPIDNT^ORWTIU(.X)
. S TEMP("cpIdentifiers")=X
D ;Copy/Paste Apps to Exclude
. N CNT2,ORLIST
. D GETLST^XPAR(.ORLIST,"ALL","ORQQTIU COPY/PASTE EXCLUDE APP","Q")
. S CNT2=""
. F S CNT2=$O(ORLIST(CNT2)) Q:CNT2="" D
. . S TEMP("cpExcludeApps",CNT2,"Name")=$P($G(ORLIST(CNT2)),U,1)
D ;Copy/Paste Notes to Exclude
. N CNT2,ORLIST
. D EXCPLST^ORWTIU(.ORLIST)
. S CNT2=""
. F S CNT2=$O(ORLIST(CNT2)) Q:CNT2="" D
. . S TEMP("cpExcludeNotes",CNT2,"Note")=$P($G(ORLIST(CNT2)),U,1)
S TEMP("cpCopyBufferDisable")=+$$GET^XPAR("PKG","ORQQTIU COPY BUFFER DISABLE",1,"I")
S TEMP("orCPRSExceptionLog","daysToPurge")=+$$GET^XPAR("ALL","OR CPRS EXCEPTION PURGE",1,"I")
S TEMP("orCPRSExceptionLog","enabled")=+$$GET^XPAR("ALL","OR CPRS EXCEPTION LOGGER",1,"I")
S TEMP("orCPRSExceptionLog","activityLogSize")=+$$GET^XPAR("ALL","OR CPRS ACTIVITY LOG SIZE",1,"I")
S TEMP("orCPRSExceptionLog","winMessageLogSize")=+$$GET^XPAR("ALL","OR CPRS WIN MESSAGE LOG SIZE",1,"I")
S TEMP("orCPRSExceptionLog","RPCLogSize")=+$$GET^XPAR("ALL","OR CPRS RPC EXCEPTION LOG SIZE",1,"I")
S TEMP("orCPRSExceptionLog","includeModuleInfo")=+$$GET^XPAR("ALL","OR CPRS EXCEPTION MODULE INFO",1,"I")
D ;CPRS Exception Email
. N CNT2,ORLIST
. D GETLST^XPAR(.ORLIST,"ALL","OR CPRS EXCEPTION EMAIL","Q")
. S CNT2=""
. F S CNT2=$O(ORLIST(CNT2)) Q:CNT2="" D
. . S TEMP("orCPRSExceptionLog","email",CNT2,"Email")=$P($G(ORLIST(CNT2)),U,2)
S TEMP("psoParkOn")=$S($$GET^XPAR("DIV^SYS^PKG","PSO PARK ON",,"E")="YES":"YES",1:"NO") ;Park-a-Prescription Enabled
D SHWOTHER^ORWOTHER(.TEMP,USER)
D GETPAR^ORPDMP(.TEMP,USER)
D GETPAR^ORGMRC(.TEMP,USER)
D GETPAR^ORCDRA(.TEMP,USER)
;Template Required Fields Identification Disabled
S TEMP("tmRequiredFldsOff")=+$$GET^XPAR("ALL","TIU REQUIRED FIELDS DISABLE",1,"I")
S TEMP("ResponsiveGUI")=$$GET^XPAR("ALL","ORWCH PAUSE INPUT")
D GETSERIES^ORFEDT(.TEMP)
D ACCESS^ORACCESS(.TEMP,USER)
D SIGI^ORWPAR1(.TEMP)
;D ENCODE^VPRJSON("TEMP","RESULTS","ERROR")
S TEMP("vitals","gmvMetricFirst")=+$$GET^XPAR("ALL","ORQQVI METRIC FIRST",1,"I")
D ENCODE^XLFJSON("TEMP",$NA(^TMP($J,"ORWU SYSPARAM")),"ERROR")
Q
;
FLDINFO(ORY,FILE,FIELD,FLAGS,ATTRIBS) ; Get field attributes
N IDX,OUT,LINE
D FIELD^DID(FILE,FIELD,FLAGS,ATTRIBS,"OUT","OUT")
S LINE=0,IDX="" F S IDX=$O(OUT(IDX)) Q:IDX="" D
. S LINE=LINE+1,ORY(LINE)=IDX_U_OUT(IDX)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWU 15449 printed Dec 13, 2024@02:37:40 Page 2
ORWU ;SLC/KCM - GENERAL UTILITIES FOR WINDOWS CALLS ;Dec 4, 2023@14:09
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,148,149,187,195,215,243,350,424,377,519,539,405,596,588,608**;Dec 17, 1997;Build 15
+2 ;
+3 ; Reference to ^%ZIS(1 supported by IA #2963
+4 ; Reference to ^%ZIS(2 supported by IA #2964
+5 ; Reference to ^DIC(3.1 supported by IA #1234
+6 ; Reference to ^SC supported by IA #10040
+7 ; Reference to ^VA(200 supported by IA #10060
+8 ; Reference to ^XUSEC( supported by IA #10076
+9 ; Reference to ^%DT supported by IA #10003
+10 ; Reference to WIN^DGPMDDCF supported by IA #1246
+11 ; Reference to FIND^DIC supported by IA #2051
+12 ; Reference to ^DID IN ICR #2052
+13 ; Reference to ^DILFD supported by IA #2055
+14 ; Reference to $$SITE^VASITE supported by IA #10112
+15 ; Reference to ^XLFJSON supported by IA #6682
+16 ; Reference to ^XLFSTR supported by IA #10104
+17 ; Reference to ^XPAR supported by IA #2263
+18 ; Reference to ^XPDUTL supported by IA #10141
+19 ; Reference to ^XQCHK supported by IA #10078
+20 ; Reference to $$KSP^XUPARAM supported by IA #2541
+21 ; Reference to $$PROD^XUPROD supported by IA #4440
+22 ; Reference to ^XUSHSHP supported by IA #10045
+23 ; Reference to $$DECRYP^XUSRB supported by IA #12241
+24 ;
+25 QUIT
DT(Y,X,%DT) ; Internal Fileman Date/Time
+1 ; change the '00:00' that could be passed so Fileman doesn't reject
+2 IF $LENGTH($PIECE(X,"@",2))
IF ("00000000"[$TRANSLATE($PIECE(X,"@",2),":",""))
SET $PIECE(X,"@",2)="00:00:01"
+3 SET %DT=$GET(%DT,"TS")
DO ^%DT
KILL %DT
+4 QUIT
VALDT(Y,X,%DT) ; Validate date/time
+1 if '$DATA(%DT)
SET %DT="TX"
DO ^%DT
+2 QUIT
USERINFO(REC) ; Relevant info for current user
+1 ; return DUZ^NAME^USRCLS^CANSIGN^ISPROVIDER^ORDERROLE^NOORDER^DTIME^
+2 ; COUNTDOWN^ENABLEVERIFY^NOTIFYAPPS^MSGHANG^DOMAIN^SERVICE^
+3 ; AUTOSAVE^INITTAB^LASTTAB^WEBACCESS^ALLOWHOLD^ISRPL^RPLLIST^
+4 ; CORTABS^RPTTAB^STANUM^GECSTATUS^PRODACCT^^JOB NUMBER^EVALREMONDIALOG
+5 NEW X,ORRPL,ORRPL1,ORRPL2,ORTAB,CORTABS,RPTTAB,ORDT,OREFF,OREXP,ORDATEOK
+6 SET REC=DUZ_U_$PIECE(^VA(200,DUZ,0),U)
+7 SET $PIECE(REC,U,3)=$SELECT($DATA(^XUSEC("ORES",DUZ)):3,$DATA(^XUSEC("ORELSE",DUZ)):2,$DATA(^XUSEC("OREMAS",DUZ)):1,1:0)
+8 SET $PIECE(REC,U,4)=$DATA(^XUSEC("ORES",DUZ))&$DATA(^XUSEC("PROVIDER",DUZ))
+9 SET $PIECE(REC,U,5)=$DATA(^XUSEC("PROVIDER",DUZ))
+10 SET $PIECE(REC,U,6)=$$ORDROLE
+11 SET $PIECE(REC,U,7)=$$GET^XPAR("USR^SYS^PKG","ORWOR DISABLE ORDERING",1,"I")
+12 SET $PIECE(REC,U,8)=$$GET^XPAR("USR^SYS","ORWOR TIMEOUT CHART",1,"I")
+13 IF '$PIECE(REC,U,8)
IF $GET(DTIME)
SET $PIECE(REC,U,8)=DTIME
+14 SET $PIECE(REC,U,9)=$$GET^XPAR("USR^SYS^PKG","ORWOR TIMEOUT COUNTDOWN",1,"I")
+15 SET X=$$GET^XPAR("USR^SYS^PKG","ORWOR ENABLE VERIFY",1,"I")
+16 SET $PIECE(REC,U,10)=$SELECT(X=1:1,X=2:0,1:'$PIECE(REC,U,7))
+17 SET $PIECE(REC,U,11)=$$GET^XPAR("USR^SYS^PKG","ORWOR BROADCAST MESSAGES",1,"I")
+18 SET $PIECE(REC,U,12)=$$GET^XPAR("USR^SYS^PKG","ORWOR AUTO CLOSE PT MSG",1,"I")
+19 ; domain
SET $PIECE(REC,U,13)=$$KSP^XUPARAM("WHERE")
+20 ; service/section
SET $PIECE(REC,U,14)=+$GET(^VA(200,DUZ,5))
+21 SET $PIECE(REC,U,15)=$$GET^XPAR("USR^SYS^PKG","ORWOR AUTOSAVE NOTE",1,"I")
+22 SET $PIECE(REC,U,16)=$$GET^XPAR("USR^DIV^SYS^PKG","ORCH INITIAL TAB",1,"I")
+23 SET $PIECE(REC,U,17)=$$GET^XPAR("USR^DIV^SYS^PKG","ORCH USE LAST TAB",1,"I")
+24 SET $PIECE(REC,U,18)=$$GET^XPAR("USR^DIV^SYS^PKG","ORWOR DISABLE WEB ACCESS",1,"I")
+25 SET $PIECE(REC,U,19)=$$GET^XPAR("SYS^PKG","ORWOR DISABLE HOLD ORDERS",1,"I")
+26 ; 2 pieces added by PKS on 11/5/2001 for "Reports Only:"
+27 ; IA# 10060 allows read access to ^VA(200 file.
+28 ; RPL node.
SET ORRPL=$GET(^VA(200,DUZ,101))
+29 SET ORRPL1=$PIECE(ORRPL,U)
+30 ; ISRPL piece.
SET $PIECE(REC,U,20)=ORRPL1
+31 SET ORRPL2=$PIECE(ORRPL,U,2)
+32 ; RPLLIST piece.
SET $PIECE(REC,U,21)=ORRPL2
+33 ;
+34 ; Additional pieces for CPRS tabs access:
+35 ; IA# 10060 allows read access to ^VA(200.01013 multiple.
+36 ; Today.
SET ORDT=DT
+37 SET (CORTABS,RPTTAB)=0
+38 SET ORRPL=0
+39 FOR
SET ORRPL=$ORDER(^VA(200,DUZ,"ORD",ORRPL))
if ORRPL<1
QUIT
Begin DoDot:1
+40 SET ORTAB=$GET(^VA(200,DUZ,"ORD",ORRPL,0))
+41 IF ORTAB=""
QUIT
+42 SET OREFF=$PIECE(ORTAB,U,2)
+43 SET OREXP=$PIECE(ORTAB,U,3)
+44 SET ORTAB=$PIECE(ORTAB,U)
+45 IF ORTAB=""
QUIT
+46 SET ORTAB=$GET(^ORD(101.13,ORTAB,0))
+47 IF ORTAB=""
QUIT
+48 SET ORTAB=$PIECE(ORTAB,U)
+49 IF ORTAB=""
QUIT
+50 SET ORTAB=$$UP^XLFSTR(ORTAB)
+51 ; Default.
SET ORDATEOK=1
+52 ; Eff. date NG.
IF ((OREFF="")!(OREFF>ORDT))
SET ORDATEOK=0
+53 IF ORDATEOK
Begin DoDot:2
+54 ; No exp. date.
IF OREXP=""
QUIT
+55 ; Exp. date NG.
IF (OREXP<ORDT)
SET ORDATEOK=0
+56 ; Exp. date NG.
IF (OREXP=ORDT)
SET ORDATEOK=0
End DoDot:2
+57 ;
+58 ; Set TRUE if OK:
+59 IF ((ORTAB="COR")&(ORDATEOK))
SET CORTABS=1
+60 IF ((ORTAB="RPT")&(ORDATEOK))
SET RPTTAB=1
End DoDot:1
+61 ;
+62 ; When done, set all valid tabs for access:
+63 ; "Core" tabs.
SET $PIECE(REC,U,22)=CORTABS
+64 ; "Reports" tab.
SET $PIECE(REC,U,23)=RPTTAB
+65 ;
+66 SET $PIECE(REC,U,24)=$PIECE($$SITE^VASITE,U,3)
+67 SET $PIECE(REC,U,25)=$$GET^XPAR("USR^TEA","PXRM GEC STATUS CHECK",1,"I")
+68 SET $PIECE(REC,U,26)=$$PROD^XUPROD
+69 SET $PIECE(REC,U,27)=$$GET^XPAR("ALL","OR ONE STEP CLINIC ADMIN OFF",1,"I")
+70 SET $PIECE(REC,U,28)=$JOB
+71 SET $PIECE(REC,U,29)=+$$GET^XPAR("USR^SYS","PXRM DIALOG EVAL DEFINITION",1,"I")
+72 QUIT
+73 ;
HASKEY(VAL,KEY) ; returns TRUE if the user possesses the security key
+1 SET VAL=''$DATA(^XUSEC(KEY,DUZ))
+2 QUIT
HASOPTN(VAL,OPTION) ; returns TRUE if the user has access to a menu option
+1 SET VAL=+$$ACCESS^XQCHK(DUZ,OPTION)
+2 IF VAL'>0
SET VAL=0
+3 IF '$TEST
SET VAL=1
+4 QUIT
NPHASKEY(VAL,NP,KEY) ; returns TRUE if the person has the security key
+1 SET VAL=''$DATA(^XUSEC(KEY,NP))
+2 QUIT
ORDROLE() ; returns the role a person takes in ordering
+1 ; VAL: 0=nokey, 1=clerk, 2=nurse, 3=physician, 4=student, 5=bad keys
+2 ;I '$G(ORWCLVER) Q 0 ; version of client is too old for ordering
+3 IF ($DATA(^XUSEC("OREMAS",DUZ))+$DATA(^XUSEC("ORELSE",DUZ))+$DATA(^XUSEC("ORES",DUZ)))>1
QUIT 5
+4 ; clerk
IF $DATA(^XUSEC("OREMAS",DUZ))
QUIT 1
+5 ; nurse
IF $DATA(^XUSEC("ORELSE",DUZ))
QUIT 2
+6 ; doctor
IF $DATA(^XUSEC("ORES",DUZ))
IF $DATA(^XUSEC("PROVIDER",DUZ))
QUIT 3
+7 ; student
IF $DATA(^XUSEC("PROVIDER",DUZ))
QUIT 4
+8 QUIT 0
VALIDSIG(ESOK,X) ; returns TRUE if valid electronic signature
+1 ; network encrypted
SET X=$$DECRYP^XUSRB1(X)
SET ESOK=0
+2 DO HASH^XUSHSHP
+3 IF X=$PIECE($GET(^VA(200,+DUZ,20)),U,4)
SET ESOK=1
+4 QUIT
+1 NEW ANENT,ORTLST,ORT,ORCNT
+2 SET ANENT="PKG"
+3 DO GETLST^XPAR(.ORLST,ANENT,"ORWT TOOLS MENU","N")
+4 SET ANENT="ALL^"_$SELECT($GET(^VA(200,DUZ,5)):"^SRV.`"_+$GET(^(5)),1:"")
+5 SET ORCNT=$ORDER(ORLST(""),-1)
+6 DO GETLST^XPAR(.ORTLST,ANENT,"ORWT TOOLS MENU","N")
+7 SET ORT=0
FOR
SET ORT=$ORDER(ORTLST(ORT))
if 'ORT
QUIT
Begin DoDot:1
+8 SET ORCNT=ORCNT+1
+9 SET ORLST(ORCNT)=ORTLST(ORT)
End DoDot:1
+10 QUIT
ACTLOC(LOC) ; Function: returns TRUE if active hospital location
+1 ; IA# 10040.
+2 ; screen out OOS entry
NEW D0,X
IF +$GET(^SC(LOC,"OOS"))
QUIT 0
+3 ; chk out of svc wards
SET D0=+$GET(^SC(LOC,42))
IF D0
DO WIN^DGPMDDCF
QUIT 'X
+4 ; no inactivate date
SET X=$GET(^SC(LOC,"I"))
IF +X=0
QUIT 1
+5 ; chk reactivate date
IF DT>$PIECE(X,U)&($PIECE(X,U,2)=""!(DT<$PIECE(X,U,2)))
QUIT 0
+6 ; must still be active
QUIT 1
+7 ;
CLINLOC(Y,FROM,DIR) ; Return a set of clinics from HOSPITAL LOCATION
+1 ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+2 NEW I,IEN,CNT
SET I=0
SET CNT=44
+3 ; IA# 10040.
FOR
if I'<CNT
QUIT
SET FROM=$ORDER(^SC("B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^SC("B",FROM,IEN),DIR)
if 'IEN
QUIT
Begin DoDot:2
+5 IF ($PIECE($GET(^SC(IEN,0)),U,3)'="C")!('$$ACTLOC(IEN))
QUIT
+6 SET I=I+1
SET Y(I)=IEN_"^"_FROM
End DoDot:2
End DoDot:1
+7 QUIT
INPLOC(Y,FROM,DIR) ;Return a set of wards from HOSPITAL LOCATION
+1 ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+2 NEW I,IEN,CNT
SET I=0
SET CNT=44
+3 ; IA# 10040.
FOR
if I'<CNT
QUIT
SET FROM=$ORDER(^SC("B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^SC("B",FROM,IEN),DIR)
if 'IEN
QUIT
Begin DoDot:2
+5 IF ($PIECE($GET(^SC(IEN,0)),U,3)'="W")
QUIT
+6 IF '$$ACTLOC(IEN)
QUIT
+7 SET I=I+1
SET Y(I)=IEN_"^"_FROM
End DoDot:2
End DoDot:1
+8 QUIT
HOSPLOC(Y,FROM,DIR) ; Return a set of locations from HOSPITAL LOCATION
+1 ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+2 NEW I,IEN,CNT
SET I=0
SET CNT=44
+3 ; IA# 10040.
FOR
if I'<CNT
QUIT
SET FROM=$ORDER(^SC("B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^SC("B",FROM,IEN),DIR)
if 'IEN
QUIT
Begin DoDot:2
+5 if ("CW"'[$PIECE($GET(^SC(IEN,0)),U,3)!('$$ACTLOC(IEN)))
QUIT
+6 SET I=I+1
SET Y(I)=IEN_"^"_FROM
End DoDot:2
End DoDot:1
+7 QUIT
NEWPERS(ORY,ORFROM,ORDIR,ORKEY,ORDATE,ORVIZ,ORALL,ORPDMP,ORSIM,OREXCLDE,ORNVA) ; Return a set of names from the NEW PERSON file.
+1 ; DEFAULT value is OFF - exclude users in the user class set in OR CPRS USER CLASS EXCLUDE (additional signers only)
SET OREXCLDE=$GET(OREXCLDE,0)
+2 ; DEFAULT is ON - include Non-VA providers
SET ORNVA=$GET(ORNVA,1)
+3 ; * ajb
+4 ; use new entry point^routine only if value is YES (default is YES)
IF $$GET^XPAR("SYS","ORNEWPERS ACTIVE")
Begin DoDot:1
+5 NEW I,PARAMS,PRM
SET PARAMS("HELP")=0
SET PRM(0)="FROM^DIR^KEY^DATE^RDV^ALL^PDMP^SPN^EXC^NVAP"
+6 ; set string of parameters from NEWPERS
SET PRM=$PIECE($PIECE($PIECE($TEXT(NEWPERS),"(",2),")"),",",2,$LENGTH($PIECE($PIECE($TEXT(NEWPERS),"(",2),")")))
+7 ; set variables to pass by reference
FOR I=1:1:$LENGTH(PRM,",")
SET PARAMS($PIECE(PRM(0),U,I))=$GET(@($PIECE(PRM,",",I)))
+8 DO NEWPERSON^ORNEWPERS(.ORY,.PARAMS)
End DoDot:1
QUIT
+9 ; * ajb
+10 ; SLC/PKS: Code moved to ORWU1 on 12/3/2002.
+11 ; ORPDMP - filter users that are authorized to make a PDMP query (p519)
+12 DO NP1^ORWU1
+13 QUIT
GBLREF(VAL,FN) ; return global reference for file number
+1 SET VAL=""
if 'FN
QUIT
+2 SET VAL=$$ROOT^DILFD(+FN)
+3 ; I $E($RE(VAL))="," S VAL=$E(VAL,1,$L(VAL)-1)_")"
+4 ; I $E($RE(VAL))="(" S VAL=$P(VAL,"(",1)
+5 QUIT
GENERIC(Y,FROM,DIR,REF) ; Return a set of entries from xref in REF
+1 ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+2 NEW I,IEN,CNT
SET I=0
SET CNT=44
+3 FOR
if I'<CNT
QUIT
SET FROM=$ORDER(@REF@(FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(@REF@(FROM,IEN),DIR)
if 'IEN
QUIT
Begin DoDot:2
+5 SET I=I+1
SET Y(I)=IEN_"^"_FROM
End DoDot:2
End DoDot:1
+6 QUIT
EXTNAME(VAL,IEN,FN) ; return external form of pointer
+1 ; IEN=internal number, FN=file number
+2 NEW REF
SET REF=$GET(^DIC(FN,0,"GL"))
SET VAL=""
+3 IF $LENGTH(REF)
IF +IEN
SET VAL=$PIECE($GET(@(REF_IEN_",0)")),U)
+4 QUIT
PARAM(VAL,APARAM) ; return a parameter value for a user
+1 ; call assumes current user, default entities, single instance
+2 SET VAL=$$GET^XPAR("ALL",APARAM,1,"I")
+3 QUIT
PARAMS(ORLIST,APARAM) ; return a list of parameter values
+1 ; call assumes current user, default entities, multiple instances
+2 DO GETLST^XPAR(.ORLIST,"ALL",APARAM,"Q")
+3 QUIT
DEVICE(Y,FROM,DIR) ; 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
SET I=0
SET CNT=20
+4 IF FROM["<"
SET FROM=$REVERSE($PIECE($REVERSE(FROM),"< ",2))
+5 FOR
if I'<CNT
QUIT
SET FROM=$ORDER(^%ZIS(1,"B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^%ZIS(1,"B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+7 NEW X0,X1,X90,X91,X95,XTYPE,XSTYPE,XTIME,ORA,ORPX,POP,ORPCNT
+8 if '$DATA(^%ZIS(1,IEN,0))
QUIT
SET X0=^(0)
SET X1=$GET(^(1))
SET X90=$GET(^(90))
SET X91=$GET(^(91))
SET X95=$GET(^(95))
SET XSTYPE=$GET(^("SUBTYPE"))
SET XTIME=$GET(^("TIME"))
SET XTYPE=$GET(^("TYPE"))
+9 ;Printers only
IF $EXTRACT($GET(^%ZIS(2,+XSTYPE,0)))'="P"
QUIT
+10 ;Device Types
SET X=$PIECE(XTYPE,"^")
IF X'="TRM"
IF X'="HG"
IF X'="HFS"
IF X'="CHAN"
QUIT
+11 ;Queuing allowed
SET X=X0
IF ($PIECE(X,U,2)="0")!($PIECE(X,U,12)=2)
QUIT
+12 ;Out of Service
SET X=+X90
IF X
IF (X'>DT)
QUIT
+13 ;Prohibited Times
IF XTIME]""
SET ORA=$PIECE(XTIME,"^")
SET ORPX=$PIECE($HOROLOG,",",2)
SET ORPCNT=ORPX\60#60+(ORPX\3600*100)
SET ORPX=$PIECE(ORA,"-",2)
IF ORPX'<ORA&(ORPCNT'>ORPX&(ORPCNT'<ORA))!(ORPX<ORA&(ORPCNT'<ORA!(ORPCNT'>ORPX)))
QUIT
+14 SET POP=0
+15 IF X95]""
SET ORPX=$GET(DUZ(0))
IF ORPX'="@"
SET POP=1
FOR ORA=1:1:$LENGTH(ORPX)
IF X95[$EXTRACT(ORPX,ORA)
SET POP=0
QUIT
+16 ;Security check
if POP
QUIT
+17 SET SHOW=$PIECE(X0,U)
IF SHOW'=FROM
SET SHOW=FROM_" <"_SHOW_">"
+18 SET I=I+1
SET Y(I)=IEN_";"_$PIECE(X0,U)_U_SHOW_U_$PIECE(X1,U)_U_$PIECE(X91,U)_U_$PIECE(X91,U,3)
End DoDot:2
End DoDot:1
+19 QUIT
URGENCY(Y) ; -- retrieve set values from dd for discharge summary urgency
+1 NEW ORDD,I,X
+2 DO FIELD^DID(8925,.09,"","POINTER","ORDD")
+3 FOR I=1:1
SET X=$PIECE(ORDD("POINTER"),";",I)
if X=""
QUIT
SET Y(I)=$TRANSLATE(X,":","^")
+4 QUIT
PATCH(VAL,X) ; Return 1 if patch X is installed
+1 SET VAL=$$PATCH^XPDUTL(X)
+2 QUIT
VERSION(VAL,X) ;Return version of package or namespace
+1 SET VAL=$$VERSION^XPDUTL(X)
+2 QUIT
VERSRV(VAL,X,CLVER) ; Return server version of option name
+1 ; leave in partition for session
SET ORWCLVER=$GET(CLVER)
+2 NEW BADVAL,ORLST
+3 DO FIND^DIC(19,"",1,"X",X,1,,,,"ORLST")
+4 IF 'ORLST("DILIST",0)
SET VAL="0.0.0.0"
QUIT
+5 SET VAL=ORLST("DILIST","ID",1,1)
+6 SET VAL=$PIECE(VAL,"version ",2)
+7 SET BADVAL=0
+8 IF $PIECE(VAL,".",1)=""
SET BADVAL=1
+9 IF $PIECE(VAL,".",2)=""
SET BADVAL=1
+10 IF $PIECE(VAL,".",3)=""
SET BADVAL=1
+11 IF $PIECE(VAL,".",4)=""
SET BADVAL=1
+12 IF ((BADVAL)!('VAL)!(VAL=""))
SET VAL="0.0.0.0"
+13 QUIT
OVERDL(VAL) ;Return parameter value of ORPARAM OVER DATELINE
+1 SET VAL=$$GET^XPAR("ALL","ORPARAM OVER DATELINE")
+2 QUIT
MOBAPP(VAL,ORAPP) ;set ^TMP($J,"OR MOB APP")
+1 SET ^TMP($JOB,"OR MOB APP")=ORAPP
+2 SET VAL=1
+3 QUIT
+4 ;
JSYSPARM(RESULTS,USER) ;
+1 NEW TEMP
+2 SET RESULTS=$NAME(^TMP($JOB,"ORWU SYSPARAM"))
+3 SET TEMP("reEvaluateReminders")=+$$GET^XPAR("USR^SYS","PXRM DIALOG EVAL DEFINITION",1,"I")
+4 ;Copy/Paste Words to Count as a Copy
Begin DoDot:1
+5 NEW X
+6 DO WRDCOPY^ORWTIU(.X,DUZ(2))
+7 SET TEMP("cpWordCopy")=X
End DoDot:1
+8 ;Copy/Paste Percent to Identify a Paste Source
Begin DoDot:1
+9 NEW X
+10 DO PCTCOPY^ORWTIU(.X,DUZ(2))
+11 SET TEMP("cpPercentCopy")=X
End DoDot:1
+12 ;Copy/Paste Allowed to View Paste Information
Begin DoDot:1
+13 NEW X
+14 DO VIEWCOPY^ORWTIU(.X,DUZ,0,DUZ(2))
+15 SET TEMP("cpViewCopy")=X
End DoDot:1
+16 ;Copy/Paste Paste Identifiers
Begin DoDot:1
+17 NEW X
+18 DO LDCPIDNT^ORWTIU(.X)
+19 SET TEMP("cpIdentifiers")=X
End DoDot:1
+20 ;Copy/Paste Apps to Exclude
Begin DoDot:1
+21 NEW CNT2,ORLIST
+22 DO GETLST^XPAR(.ORLIST,"ALL","ORQQTIU COPY/PASTE EXCLUDE APP","Q")
+23 SET CNT2=""
+24 FOR
SET CNT2=$ORDER(ORLIST(CNT2))
if CNT2=""
QUIT
Begin DoDot:2
+25 SET TEMP("cpExcludeApps",CNT2,"Name")=$PIECE($GET(ORLIST(CNT2)),U,1)
End DoDot:2
End DoDot:1
+26 ;Copy/Paste Notes to Exclude
Begin DoDot:1
+27 NEW CNT2,ORLIST
+28 DO EXCPLST^ORWTIU(.ORLIST)
+29 SET CNT2=""
+30 FOR
SET CNT2=$ORDER(ORLIST(CNT2))
if CNT2=""
QUIT
Begin DoDot:2
+31 SET TEMP("cpExcludeNotes",CNT2,"Note")=$PIECE($GET(ORLIST(CNT2)),U,1)
End DoDot:2
End DoDot:1
+32 SET TEMP("cpCopyBufferDisable")=+$$GET^XPAR("PKG","ORQQTIU COPY BUFFER DISABLE",1,"I")
+33 SET TEMP("orCPRSExceptionLog","daysToPurge")=+$$GET^XPAR("ALL","OR CPRS EXCEPTION PURGE",1,"I")
+34 SET TEMP("orCPRSExceptionLog","enabled")=+$$GET^XPAR("ALL","OR CPRS EXCEPTION LOGGER",1,"I")
+35 SET TEMP("orCPRSExceptionLog","activityLogSize")=+$$GET^XPAR("ALL","OR CPRS ACTIVITY LOG SIZE",1,"I")
+36 SET TEMP("orCPRSExceptionLog","winMessageLogSize")=+$$GET^XPAR("ALL","OR CPRS WIN MESSAGE LOG SIZE",1,"I")
+37 SET TEMP("orCPRSExceptionLog","RPCLogSize")=+$$GET^XPAR("ALL","OR CPRS RPC EXCEPTION LOG SIZE",1,"I")
+38 SET TEMP("orCPRSExceptionLog","includeModuleInfo")=+$$GET^XPAR("ALL","OR CPRS EXCEPTION MODULE INFO",1,"I")
+39 ;CPRS Exception Email
Begin DoDot:1
+40 NEW CNT2,ORLIST
+41 DO GETLST^XPAR(.ORLIST,"ALL","OR CPRS EXCEPTION EMAIL","Q")
+42 SET CNT2=""
+43 FOR
SET CNT2=$ORDER(ORLIST(CNT2))
if CNT2=""
QUIT
Begin DoDot:2
+44 SET TEMP("orCPRSExceptionLog","email",CNT2,"Email")=$PIECE($GET(ORLIST(CNT2)),U,2)
End DoDot:2
End DoDot:1
+45 ;Park-a-Prescription Enabled
SET TEMP("psoParkOn")=$SELECT($$GET^XPAR("DIV^SYS^PKG","PSO PARK ON",,"E")="YES":"YES",1:"NO")
+46 DO SHWOTHER^ORWOTHER(.TEMP,USER)
+47 DO GETPAR^ORPDMP(.TEMP,USER)
+48 DO GETPAR^ORGMRC(.TEMP,USER)
+49 DO GETPAR^ORCDRA(.TEMP,USER)
+50 ;Template Required Fields Identification Disabled
+51 SET TEMP("tmRequiredFldsOff")=+$$GET^XPAR("ALL","TIU REQUIRED FIELDS DISABLE",1,"I")
+52 SET TEMP("ResponsiveGUI")=$$GET^XPAR("ALL","ORWCH PAUSE INPUT")
+53 DO GETSERIES^ORFEDT(.TEMP)
+54 DO ACCESS^ORACCESS(.TEMP,USER)
+55 DO SIGI^ORWPAR1(.TEMP)
+56 ;D ENCODE^VPRJSON("TEMP","RESULTS","ERROR")
+57 SET TEMP("vitals","gmvMetricFirst")=+$$GET^XPAR("ALL","ORQQVI METRIC FIRST",1,"I")
+58 DO ENCODE^XLFJSON("TEMP",$NAME(^TMP($JOB,"ORWU SYSPARAM")),"ERROR")
+59 QUIT
+60 ;
FLDINFO(ORY,FILE,FIELD,FLAGS,ATTRIBS) ; Get field attributes
+1 NEW IDX,OUT,LINE
+2 DO FIELD^DID(FILE,FIELD,FLAGS,ATTRIBS,"OUT","OUT")
+3 SET LINE=0
SET IDX=""
FOR
SET IDX=$ORDER(OUT(IDX))
if IDX=""
QUIT
Begin DoDot:1
+4 SET LINE=LINE+1
SET ORY(LINE)=IDX_U_OUT(IDX)
End DoDot:1
+5 QUIT
