Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORQPTQ11

ORQPTQ11.m

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