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