- ORQPTQ11 ; SLC/CLA - Functs which return patient lists and sources pt 1B ;05/21/14 21:32
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**82,85,109,132,173,253,320,377**;Dec 17, 1997;Build 582
- ;
- ; SLC/PKS - Modified to deal with "Combination" lists - 3/2000.
- ; SLC/PKS - Additions for "Restricted Pt. Lists" - 11/2001.
- ; SLC/TDP - Additions for PCMM Teams - 5/2014.
- ;
- 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"
- ; TDP - PCMM Team (E) added 5/21/2014
- I FROM="E" S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PCMM TEAM",1,"B")_"^PCMM 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="E" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PCMM TEAM",1,"B")_"^PCMM 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="E" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PCMM TEAM",1,"B")_"^PCMM 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="E" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PCMM TEAM",1,"Q") D:+$G(IEN)>0 PTEAMPTS^ORQPTQ1(.Y,IEN) ;TDP(377) - Need complete patient retrieval code
- 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 CLINPTS2^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=0
- .F S ORQCNT=$O(Y(ORQCNT)) Q:ORQCNT="" S ORQDAT=Y(ORQCNT) D
- ..S ^TMP("OR",$J,"PATIENTS",ORQCNT,0)=ORQDAT
- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQPTQ11 10330 printed Feb 18, 2025@23:59:59 Page 2
- ORQPTQ11 ; SLC/CLA - Functs which return patient lists and sources pt 1B ;05/21/14 21:32
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**82,85,109,132,173,253,320,377**;Dec 17, 1997;Build 582
- +2 ;
- +3 ; SLC/PKS - Modified to deal with "Combination" lists - 3/2000.
- +4 ; SLC/PKS - Additions for "Restricted Pt. Lists" - 11/2001.
- +5 ; SLC/TDP - Additions for PCMM Teams - 5/2014.
- +6 ;
- 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 ; TDP - PCMM Team (E) added 5/21/2014
- +8 IF FROM="E"
- SET Y=$$GET^XPAR("USR^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT PCMM TEAM",1,"B")_"^PCMM Team"
- +9 IF FROM="W"
- SET Y=$$GET^XPAR("USR^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT WARD",1,"B")_"^Ward"
- +10 IF FROM="P"
- SET Y=$$GET^XPAR("USR^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
- +11 IF FROM="S"
- SET Y=$$GET^XPAR("USR^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
- +12 IF FROM="C"
- Begin DoDot:1
- +13 SET API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
- +14 SET Y=$$GET^XPAR("USR^SRV.`"_+$GET(ORSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
- End DoDot:1
- +15 IF FROM="M"
- SET Y="^Combination"
- +16 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="E"
- SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT PCMM TEAM",1,"B")_"^PCMM Team"
- +8 IF FROM="W"
- SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT WARD",1,"B")_"^Ward"
- +9 IF FROM="P"
- SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
- +10 IF FROM="S"
- SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
- +11 IF FROM="C"
- Begin DoDot:1
- +12 SET API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
- +13 SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
- End DoDot:1
- +14 IF FROM="M"
- SET RESULT="^Combination"
- +15 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="E"
- SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT PCMM TEAM",1,"B")_"^PCMM Team"
- +8 IF TYPE="W"
- SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT WARD",1,"B")_"^Ward"
- +9 IF TYPE="P"
- SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
- +10 IF TYPE="S"
- SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
- +11 IF TYPE="C"
- Begin DoDot:1
- +12 SET API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
- +13 SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
- End DoDot:1
- +14 IF TYPE="M"
- SET RESULT="Combination"
- +15 IF $PIECE(RESULT,U)=""
- SET RESULT=U_RESULT
- +16 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 ;TDP(377) - Need complete patient retrieval code
- IF FROM="E"
- SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(ORSRV),"ORLP DEFAULT PCMM TEAM",1,"Q")
- if +$GET(IEN)>0
- DO PTEAMPTS^ORQPTQ1(.Y,IEN)
- +10 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)
- +11 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)
- +12 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)
- +13 IF FROM="C"
- Begin DoDot:1
- +14 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
- +15 SET BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
- +16 IF BEG="T+0"
- SET BEG=$$FMTE^XLFDT(DT,BEG)
- +17 SET END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
- +18 IF END="T+0"
- SET END=$$FMTE^XLFDT(DT,END)
- +19 DO CLINPTS2^ORQPTQ2(.Y,+$GET(IEN),BEG,END)
- End DoDot:2
- End DoDot:1
- +20 IF FROM="M"
- Begin DoDot:1
- +21 SET IEN=$DATA(^OR(100.24,DUZ,0))
- IF +$GET(IEN)>0
- SET IEN=DUZ
- Begin DoDot:2
- +22 SET BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
- +23 IF BEG="T+0"
- SET BEG=$$FMTE^XLFDT(DT,BEG)
- +24 SET END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
- +25 IF END="T+0"
- SET END=$$FMTE^XLFDT(DT,END)
- +26 ; "0"= GUI RPC call.
- DO COMBPTS^ORQPTQ6(0,+$GET(IEN),BEG,END)
- End DoDot:2
- End DoDot:1
- +27 ; Combinations already written to global.
- IF ($$BROKER^XWBLIB)&(FROM'="M")
- Begin DoDot:1
- +28 SET ORQDAT=""
- SET ORQCNT=0
- +29 FOR
- SET ORQCNT=$ORDER(Y(ORQCNT))
- if ORQCNT=""
- QUIT
- SET ORQDAT=Y(ORQCNT)
- Begin DoDot:2
- +30 SET ^TMP("OR",$JOB,"PATIENTS",ORQCNT,0)=ORQDAT
- 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 ;