- 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 Jan 18, 2025@03:38:49 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