214 lines
9.3 KiB
Mathematica
214 lines
9.3 KiB
Mathematica
ORQPTQ11 ; SLC/CLA - Functs which return patient lists and sources pt 1B ;12/15/97 [ 08/04/97 3:32 PM ] [6/6/03 2:36pm]
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**82,85,109,132,173,253**;Dec 17, 1997
|
|
;
|
|
; SLC/PKS - Modified to deal with "Combination" lists - 3/2000.
|
|
; SLC/PKS - Additions for "Restricted Pt. Lists" - 11/2001.
|
|
;
|
|
DEFSRC(Y) ; return current user's default list source
|
|
Q:'$D(DUZ)
|
|
N FROM,API,ORSRV
|
|
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
|
|
S FROM=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
|
|
Q:'$L($G(FROM))
|
|
I FROM="T" S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT TEAM",1,"B")_"^Team"
|
|
I FROM="W" S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT WARD",1,"B")_"^Ward"
|
|
I FROM="P" S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
|
|
I FROM="S" S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
|
|
I FROM="C" D
|
|
.S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
|
|
.S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
|
|
I FROM="M" S Y="^Combination"
|
|
Q
|
|
FDEFSRC(ORDUZ) ; extrinsic function return user's (ORDUZ) default list source
|
|
Q:'$D(ORDUZ) "^^Error: No user identified"
|
|
N FROM,API,RESULT,ORSRV
|
|
S ORSRV=$G(^VA(200,ORDUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
|
|
S FROM=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
|
|
Q:'$L($G(FROM)) "^^No default list source specified"
|
|
I FROM="T" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT TEAM",1,"B")_"^Team"
|
|
I FROM="W" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT WARD",1,"B")_"^Ward"
|
|
I FROM="P" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
|
|
I FROM="S" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
|
|
I FROM="C" D
|
|
.S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
|
|
.S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
|
|
I FROM="M" S RESULT="^Combination"
|
|
Q RESULT
|
|
LISTSRC(ORDUZ,TYPE) ; extrinsic function return user's (ORDUZ) list source
|
|
; for list type team, ward, primary provider, specialty, clinic, combination (TYPE)
|
|
Q:'$D(ORDUZ) "^^Error: No user identified"
|
|
Q:'$D(TYPE) "^^Error: No list type identified"
|
|
N API,RESULT,ORSRV
|
|
S ORSRV=$G(^VA(200,ORDUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
|
|
I TYPE="T" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT TEAM",1,"B")_"^Team"
|
|
I TYPE="W" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT WARD",1,"B")_"^Ward"
|
|
I TYPE="P" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
|
|
I TYPE="S" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
|
|
I TYPE="C" D
|
|
.S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
|
|
.S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
|
|
I TYPE="M" S RESULT="Combination"
|
|
I $P(RESULT,U)="" S RESULT=U_RESULT
|
|
Q RESULT
|
|
DEFLIST(Y) ; return current user's default patient list
|
|
I $$BROKER^XWBLIB S Y=$NA(^TMP("OR",$J,"PATIENTS")) ; GUI = global.
|
|
I '$$BROKER^XWBLIB S ^TMP("OR",$J,"PATIENTS",0)=""
|
|
Q:'$D(DUZ)
|
|
N FROM,IEN,BEG,END,API,ORSRV,ORQDAT,ORQCNT,ORGUI
|
|
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U) ; Get S/S.
|
|
S FROM=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
|
|
Q:'$L($G(FROM))
|
|
I FROM="T" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT TEAM",1,"Q") D:+$G(IEN)>0 TEAMPTS^ORQPTQ1(.Y,IEN)
|
|
I FROM="W" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT WARD",1,"Q") D:+$G(IEN)>0 BYWARD^ORWPT(.Y,IEN)
|
|
I FROM="P" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"Q") D:+$G(IEN)>0 PROVPTS^ORQPTQ2(.Y,IEN)
|
|
I FROM="S" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"Q") D:+$G(IEN)>0 SPECPTS^ORQPTQ2(.Y,IEN)
|
|
I FROM="C" D
|
|
.S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT)),IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),API,1,"Q") I +$G(IEN)>0 D
|
|
..S BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
|
|
..I BEG="T+0" S BEG=$$FMTE^XLFDT(DT,BEG)
|
|
..S END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
|
|
..I END="T+0" S END=$$FMTE^XLFDT(DT,END)
|
|
..D CLINPTS^ORQPTQ2(.Y,+$G(IEN),BEG,END)
|
|
I FROM="M" D
|
|
.S IEN=$D(^OR(100.24,DUZ,0)) I +$G(IEN)>0 S IEN=DUZ D
|
|
..S BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
|
|
..I BEG="T+0" S BEG=$$FMTE^XLFDT(DT,BEG)
|
|
..S END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
|
|
..I END="T+0" S END=$$FMTE^XLFDT(DT,END)
|
|
..D COMBPTS^ORQPTQ6(0,+$G(IEN),BEG,END) ; "0"= GUI RPC call.
|
|
I ($$BROKER^XWBLIB)&(FROM'="M") D ; Combinations already written to global.
|
|
.S ORQDAT="",ORQCNT=1
|
|
.F S ORQDAT=$G(Y(ORQCNT)) Q:ORQDAT="" D
|
|
..S ^TMP("OR",$J,"PATIENTS",ORQCNT,0)=ORQDAT
|
|
..S ORQCNT=ORQCNT+1
|
|
I ('$$BROKER^XWBLIB) S Y=FROM_";"_+$G(IEN)_";"_$G(BEG)_";"_$G(END) ; MKB 10/13/95
|
|
Q
|
|
DEFSORT(Y) ; Return user's default sort.
|
|
; SLC/PKS - 4/6/2001
|
|
;
|
|
N ORSORT,ORSECT,ORPARAM
|
|
;
|
|
I ('$D(DUZ)) S Y="Unable to determine DUZ." Q
|
|
S ORSECT=$G(^VA(200,DUZ,5))
|
|
I +ORSECT>0 S ORSECT=$P(ORSECT,U)
|
|
S Y="A" ; Default of "Alpha" sort.
|
|
S ORPARAM="ORLP DEFAULT LIST ORDER"
|
|
S ORSORT=$$GET^XPAR("USR^SRV.`"_$G(ORSECT)_"^DIV^SYS^PKG",ORPARAM,1,"I")
|
|
I (ORSORT'="") S Y=ORSORT
|
|
;
|
|
Q
|
|
;
|
|
PNAMWRIT(ORROOT,ORDFN) ; Write patient name to ^TMP global.
|
|
;
|
|
; Variables used:
|
|
;
|
|
; ORDFN = Passed patient DFN.
|
|
; ORNAME = Patient name.
|
|
; ORROOT = ^TMP root passed by calling code.
|
|
; ORWRITE = Holder for ^TMP node for writing.
|
|
;
|
|
N ORNAME,ORWRITE
|
|
S ORROOT=ORROOT_"," ; Add necessary comma.
|
|
;
|
|
S ORNAME="" ; Initializae.
|
|
S ORNAME=$G(^DPT(ORDFN,0)) ; Get zero node pt. data.
|
|
S ORNAME=$P(ORNAME,U) ; Extract pt. name only.
|
|
I ORNAME="" Q 0 ; Problem - punt.
|
|
;
|
|
; Create naked reference string for writing to ^TMP:
|
|
S ORWRITE=ORROOT_""""_ORNAME_""""_","_ORDFN_")"
|
|
S @ORWRITE=ORDFN_U_ORNAME ; Write to ^TMP.
|
|
;
|
|
Q 1
|
|
;
|
|
RPLMAKE(Y,ORTL) ; Make global restricted pt. array from Team List.
|
|
;
|
|
; Variables used:
|
|
;
|
|
; ORDFN = Holder for patient DFN.
|
|
; ORJ = Holds $J value.
|
|
; ORREAD = Holder for ^TMP root to kill.
|
|
; ORRET = Returned value from function call.
|
|
; ORROOT = ^TMP root to pass.
|
|
; ORTL = Team List IEN.
|
|
; ORX = Working variable used in $ORDER statement.
|
|
; Y = Returned value (same as ORJ).
|
|
;
|
|
N ORDFN,ORJ,ORREAD,ORRET,ORROOT,ORX
|
|
;
|
|
I ORTL="" S Y="" Q ; No Team List IEN passed.
|
|
I $G(^OR(100.21,ORTL,0))="" S Y="" Q ; No such Team List.
|
|
;
|
|
S (ORJ,Y)=$J ; Assign returned value.
|
|
S ORROOT="^TMP("_"""ORRPL"""_"," ; Initial setting.
|
|
S ORROOT=ORROOT_ORJ_","_"""B""" ; Add job number, "B."
|
|
S ORREAD=ORROOT_")" ; Assign "kill" root.
|
|
K @ORREAD ; Kill old, if any.
|
|
;
|
|
; From Team List B x-ref, obtain patients, create new ^TMP entries:
|
|
S ORX="" ; Initialize.
|
|
F S ORX=$O(^OR(100.21,ORTL,10,"B",ORX)) Q:ORX="" D
|
|
.S ORDFN=$P(ORX,";") ; Extract patient DFN.
|
|
.S ORRET=$$PNAMWRIT(ORROOT,ORDFN) ; Call that writes to ^TMP.
|
|
;
|
|
Q
|
|
;
|
|
RPLREAD(Y,ORJ,ORFROM,ORDIR) ; Read disk-based patient array from TMP.
|
|
;
|
|
; Variables used:
|
|
;
|
|
; ORCNT = Counter variable.
|
|
; ORDIR = Direction to move through list.
|
|
; ORFROM = Starting point from which to move through list.
|
|
; ORI = Counter variable.
|
|
; ORIEN = Record IEN holder.
|
|
; ORJ = Job number to use in ^TMP global root.
|
|
; ORROOT = ^TMP global file root.
|
|
; ORZ = Temporary value holder.
|
|
; Y = Returned array.
|
|
;
|
|
N ORCNT,ORI,ORIEN,ORROOT,ORZ
|
|
;
|
|
I $P(ORFROM,U,2)'="" S ORFROM=$P(ORFROM,U,2)
|
|
;
|
|
S ORROOT="^TMP("_"""ORRPL"""_","_ORJ ; Initial setting.
|
|
S ORROOT=ORROOT_","_"""B""" ; Add final text.
|
|
;
|
|
; Check for existence of data:
|
|
I '$D(@(ORROOT_")")) S Y(0)="No data available." Q
|
|
;
|
|
S ORROOT=ORROOT_"," ; Add comma.
|
|
S ORCNT=44 ; Initialize to maximum.
|
|
S ORI=0 ; Initialize.
|
|
;
|
|
; Loop through ^TMP entries for data to return:
|
|
F S ORFROM=$O(@(ORROOT_""""_ORFROM_""""_")"),ORDIR) Q:ORFROM="" D Q:ORI=ORCNT
|
|
.;
|
|
.; Sub-loop for entries up to ORCNT maximum:
|
|
.S ORIEN=0 ; Initialize.
|
|
.F S ORIEN=$O(@(ORROOT_""""_ORFROM_""""_","_ORIEN_")")) Q:'ORIEN D Q:ORI=ORCNT
|
|
..S ORI=ORI+1 ; Increment counter.
|
|
..;
|
|
..; Assign return array:
|
|
..S Y(ORI)=@(ORROOT_""""_ORFROM_""""_","_ORIEN_")")
|
|
;
|
|
Q
|
|
;
|
|
RPLCLEAN(Y,ORJ) ; Kill global data using passed global root value.
|
|
;
|
|
; Variables used:
|
|
;
|
|
; ORJ = Job number to use in ^TMP global root.
|
|
; ORROOT = Root of ^TMP global to kill.
|
|
; Y = Returned RPC value.
|
|
;
|
|
N ORROOT
|
|
;
|
|
S Y=1 ; Initialize.
|
|
S ORROOT="^TMP("_"""ORRPL"""_"," ; Initial setting.
|
|
S ORROOT=ORROOT_ORJ_","_"""B"""_")" ; Add rest.
|
|
K @ORROOT ; Kill global data.
|
|
;
|
|
Q
|
|
;
|