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

ORLP.m

Go to the documentation of this file. 
  1. ORLP ; SLC/CLA - Manager for Team List options ; 5/30/08 6:28am
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**47,90,98,243**;Dec 17, 1997;Build 242
  1.  ;
  1. CLEAR ; From TM, MERG^ORLP1, END^ORLP0.
  1.  K ^XUTL("OR",$J,"ORLP"),^("ORV"),^("ORU"),^("ORW") S ORCNT=0
  1.  Q
  1.  ;
  1. TM ; From option ORLP TEAM ADD - create/add a team list.
  1.  N ORLTYP
  1.  D CLEAR
  1.  W @IOF,!,"A team list is a list containing patients related to several providers.",!,"These providers are the list's users.  You may now create a new team list"
  1.  W !,"or add autolinks, users and/or patients to an existing team list.  Autolinks",!,"automatically add or remove patients with ADT movements.  Users on the list"
  1.  W !,"may receive notifications regarding patients on the same list.  Please prefix",!,"your list name with 'TEAM' or 'SERVICE' (e.g. TEAM7B, SERVICECARDIOLOGY.)",!
  1.  D ASKLIST,END
  1.  Q
  1.  ;
  1. ASKLIST ; Ask for team list.
  1.  ; NOTE: For new entries, TYPE field is required and trigger
  1.  ;       stuffs CREATOR field with DUZ of current user.
  1.  ;
  1. AL N DLAYGO,DIC,DIE,DIK,DR,ORFLAG,ORLTNAM,OROWNER,ORROOT,ORDA,ORYY
  1.  N DIR S DIR(0)="FAO^3:30",DIR("A")="Enter team list name: "
  1.  D ^DIR
  1.  I '$D(X)!$D(DIRUT) K DIR,DIRUT Q
  1.  S ORLTNAM=$$CHKNAM(Y)                 ; Check for duplication.
  1.  K DIR
  1.  N DIC S X=$G(X),(ORROOT,DIC)="^OR(100.21,",DLAYGO=100.21,DIC(0)="LEFQZ" D ^DIC
  1.  I '$D(X)!(+Y<0)!$D(DIRUT) K DIRUT Q   ; User aborted or problem.
  1.  I +Y,'+$G(^OR(100.21,+Y,11)) S ^OR(100.21,+Y,11)="0^"
  1.  ; Check for "Personal" lists (and not a new entry):
  1.  I ORLTNAM>0,(+Y>0),$P($G(^OR(100.21,+Y,0)),U,2)="P" W !!,"     Personal lists cannot be edited here.",! G AL
  1.  S (ORYY,TEAM)=Y,ORDA=+Y,TEAM(0)=Y(0),^TMP("ORLP",$J,"TLIST")=+Y K DIC
  1.  ; Check for entry of team type (new team entry):
  1.  I $P(TEAM,U,3) D  Q
  1.  .I $P(TEAM(0),U,2)="" D
  1.  ..SET Y=TEAM,Y(0)=TEAM(0) ; Reassign in case DIE previously called.
  1.  ..N DIE S DIE=ORROOT,DA=+Y,DR="1  Enter type:  ~R" D ^DIE I $O(Y(0)) S DIK=DIE D ^DIK Q
  1.  .S (ORLTYP,OROWNER)=""
  1.  .S ORLTYP=$P(^OR(100.21,+TEAM,0),U,2) Q:'$L(ORLTYP)
  1.  .; Check for "P" type, ask for user/owner input:
  1.  .I ORLTYP="P" D OWNER^ORLP1 ; Sets OROWNER variable.
  1.  .I (ORLTYP="P")&(OROWNER="") S DIK=ORROOT,DA=ORDA D ^DIK Q
  1.  .;
  1.  .; Allow further editing of autolink type teams:
  1.  .I ORLTYP["A" S:'$D(^OR(100.21,+TEAM,2,0)) ^(0)="^100.213AVI^^" D  Q
  1.  .. D ASKLINK,ASKUSER,ASKDEV,ASKSUB
  1.  .;
  1.  .; Proceed with editing for "TM" type teams:
  1.  .D ASKPT^ORLP00(+TEAM),ASKUSER,ASKDEV
  1.  ;
  1.  ; For existing teams, display team type:
  1.  W !,"  Type: "_$S($P(Y(0),U,2)="TM":"Manual Team List",$P(Y(0),U,2)="TA":"Autolinked Team List",$P(Y(0),U,2)="MRAL":"Manual Removal Autolinked Team List",1:"(Unknown)")
  1.  ;
  1.  ; Lock before allowing editing:
  1.  I $O(^OR(100.21,+TEAM,10,0)) L +^OR(100.21,+TEAM):3 I '$T W !?5,"  Another user is editing this entry." Q
  1.  ;
  1.  ; Allow applicable editing for all types but "TM" teams:
  1.  I $P(TEAM(0),U,2)'="TM" D
  1.  . D ASKLINK,ASKUSER,ASKDEV
  1.  . ;
  1.  . ; Editing of "subscription" attribute for "TA" and "MRAL" teams:
  1.  . I $P(TEAM(0),U,2)["A" D
  1.  . . D ASKSUB
  1.  ;
  1.  ; Proceed with editing for "TM" type teams:
  1.  I $P(TEAM(0),U,2)="TM" D ASKPT^ORLP00(+TEAM),ASKUSER,ASKDEV
  1.  Q
  1.  ;
  1.  N DIC,DA,DLAYGO,Y,DUOUT,LVP,LVPT,LNAME
  1.  W !
  1.  F  K DIC,DA,DUOUT D  I LVP<1 Q
  1.  .S DLAYGO=100.21,DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",2,",DIC(0)="AELMQZ",DIC("A")="  Enter team autolink: "
  1.  .D ^DIC S LVP=Y I Y<1 Q
  1.  .I $P($G(Y),U,3)=1 D
  1.  ..S LNAME=Y(0,0)
  1.  ..I LVP["VA(200" F  D  Q:'$D(Y)
  1.  ...S DA(1)=+TEAM,DIE="^OR(100.21,"_DA(1)_",2,",DA(1)=+TEAM,DA=+LVP,DR="1R" D ^DIE I $D(Y) W !,"  This field is required in order for Provider autolinks to work correctly.",!,"  Please answer the question."
  1.  ..S LVPT=$P($G(^OR(100.21,+TEAM,2,+LVP,0)),U,2)
  1.  ..; For clinics, take a fork in the road:
  1.  ..I $P($P(LVP,U,2),";",2)="SC(" D BYCL(LVP) Q
  1.  ..; For autolinks besides clinics, truck on:
  1.  ..D ADDLPTS
  1.  Q
  1.  ;
  1. ADDLPTS ; Add patients linked to autolink.
  1.  W !
  1.  W !,"       [ADT movements linked to "
  1.  W !,"          ",LNAME
  1.  W !,"        will now automatically add patients to this list.]"
  1.  S LINK=$P(LVP,U,2),FILE="^"_$P(LINK,";",2),X="",CNT=0
  1.  W !!,"       Adding patients linked to ",LNAME,"..."
  1.  W !
  1.  I FILE="^DIC(42," D LOOPTS("CN",LNAME) Q
  1.  I FILE="^DG(405.4," D LOOPTS("RM",LNAME) Q
  1.  I FILE="^VA(200," D  Q
  1.  . ; Variable LVPT determines if provider pointer is for:
  1.  . ;    B - Both Primary and Attending
  1.  . ;    A - Attending
  1.  . ;    P - Primary
  1.  . I LVPT["B" D LOOPTS("APR",+LINK) N CNTAPR S CNTAPR=CNT,CNT=0 D LOOPTS("AAP",+LINK) Q
  1.  . I LVPT["P" D LOOPTS("APR",+LINK) Q
  1.  . I LVPT["A" D LOOPTS("AAP",+LINK)
  1.  I FILE="^DIC(45.7," D LOOPTS("ATR",+LINK) Q
  1.  Q
  1.  ;
  1. BYCL(CLINIC) ; SLC/PKS - 6/99 - Return list of clinic patients by enrollment.
  1.  ;
  1.  ; Called by ASKLINK.
  1.  ;
  1.  ; Variables used:
  1.  ;
  1.  ;    CLINIC  = Clinic to search.
  1.  ;    ORLIST  = Array, returned by call to PTCL^SCAPMC.
  1.  ;    ORERR   = Array for errors, returned by call to PTCL^SCAPMC.
  1.  ;    ORRET  = Flag for problem with PTCL^SCAPMC call.
  1.  ;    RESULT  = Holds result of PTCL^SCAPMC call (1=OK, 0=error).
  1.  ;    RCD     = Holder for each record in ^TMP of PTCL^SCAPMC.
  1.  ;    DFN     = Patient IEN.
  1.  ;    ALCNT   = Count of autolink patients added.
  1.  ;    DUPCNT  = Count of duplicate patients already on list.
  1.  ;    X       = Temp value holder variable.
  1.  ;
  1.  N DIC,DA,DO,DD,ORLIST,ORERR,RESULT,RCD,DFN,ALCNT,DUPCNT,X,ORRET
  1.  ;
  1.  ; Assign clinic variable:
  1.  S CLINIC=$P(CLINIC,"^",2)
  1.  S CLINIC=$P(CLINIC,";")
  1.  ;
  1.  ; Keep user informed:
  1.  W !
  1.  W !,"       [Patient enrollments linked to "
  1.  W !,"          ",LNAME
  1.  W !,"        will now automatically add patients to this list.]"
  1.  W !
  1.  W !,"       Adding patients enrolled in ",LNAME,"..."
  1.  W !
  1.  ;
  1.  ; Process the Autolink entries:
  1.  K ^TMP("SC TMP LIST") ; Clean up potential leftover data.
  1.  S ORRET=1
  1.  S RESULT=$$PTCL^SCAPMC(CLINIC,,.ORLIST,.ORERR)
  1.  I $L($G(RESULT)) D   ; Make sure something was returned.
  1.  .I RESULT>0 S ORRET=0 ; Was return value 1 or more?
  1.  I ORRET W !,"  Error in processing - patients will not be added." Q  ; Abort if there's a problem.
  1.  ; Clinic patients should now be in ^TMP("SC TMP LIST",$J file.
  1.  ;
  1.  ; Write the patients to the OE/RR LIST file:
  1.  S ALCNT=0  ; Initialize autolink counter.
  1.  S DUPCNT=0 ; Initialize duplicate counter.
  1.  S RCD=0    ; Initialize to start with first data record.
  1.  F  S RCD=$O(^TMP("SC TMP LIST",$J,RCD)) Q:'RCD  D  ; Each record.
  1.  .S DFN=$P(^TMP("SC TMP LIST",$J,RCD),"^")          ; Patient IEN.
  1.  .S X=DFN_";DPT(" ; Add ";DPT(" to patient string.
  1.  .I $D(^OR(100.21,+TEAM,10,"B",X)) S DUPCNT=DUPCNT+1 Q  ; This patient already on list - increment dupe counter.
  1.  .S:'$D(^OR(100.21,+TEAM,10,0)) ^(0)="^100.2101AV^^"
  1.  .K DIC,DA,DO,DD
  1.  .S DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L"
  1.  .D FILE^DICN
  1.  .I +X S ALCNT=ALCNT+1 ; Increment counter.
  1.  .Q  ; Loop for each record in ^TMP file.
  1.  ;
  1.  ; Give user the results:
  1.  I ALCNT>0 W !,"       "_ALCNT_" patient(s) added to list."
  1.  I ALCNT=0 W !,"       No linked patients found."
  1.  I DUPCNT>0 W !,"       "_DUPCNT_" patient(s) already on list."
  1.  W !
  1.  K ^TMP("SC TMP LIST",$J) ; Clean up ^TMP file entries.
  1.  ;
  1.  Q
  1.  ;
  1. LOOPTS(REF,DEX) ;
  1.  S ORLPT=0 F  S ORLPT=$O(^DPT(REF,DEX,ORLPT)) Q:ORLPT'>0  S X=ORLPT_";DPT(" D ADDLOOP
  1.  I $D(LVPT),LVPT["B"!(LVPT']"") Q:REF="APR"
  1.  I +X W !,$S(+CNT:"       "_(+$G(CNTAPR)+(+CNT))_" patient(s) added.",1:"       Linked patients already on list.")
  1.  E  W "       No linked patients found."
  1.  W !
  1.  K DEX,FILE,MSG,REF,X,Y
  1.  Q
  1.  ;
  1. ASKUSER ; From ASKLIST - ask for providers/users.
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  W !
  1.  S:'$D(^OR(100.21,+TEAM,1,0)) ^(0)="^100.212PA^^"
  1.  K DIC,DA
  1.  S DLAYGO=100.212,DA(1)=+TEAM
  1.  S DIC("P")="100.212PA",DIC="^OR(100.21,"_DA(1)_",1,",DIC(0)="AELMQ"
  1.  S DIC("A")="  Enter team provider/user: "
  1.  ; SLC/PKS - Next line added on 4/11/2000:
  1.  S DIC("S")="I $D(X),$D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),$$ACTIVE^XUSER(+Y)"
  1.  F  D  Q:Y<1
  1.  .D ^DIC
  1.  .I '(Y<1) W !
  1.  K DIC,DA,DLAYGO
  1.  Q
  1.  ;
  1. ASKDEV ; From ASKLIST - ask for device.
  1.  ;
  1.  ; New, by PKS - 7/29/99:
  1.  Q:$D(DTOUT)!($D(DUOUT))  ; Previous interaction fail?
  1.  W !
  1.  N DIE,DR
  1.  S DIE="^OR(100.21,"
  1.  S DA=+TEAM
  1.  S DR="1.5  Enter device: "
  1.  D ^DIE ; Writes to DEVICE field.
  1.  K DIE
  1.  Q
  1.  ;
  1. ASKSUB ; From ASKLIST - Ask re: subscription status.
  1.  ; (PKS - 8/1999)
  1.  ;
  1.  Q:$D(DTOUT)!($D(DUOUT))  ; Previous interaction fail?
  1.  W !
  1.  N DIE,DR
  1.  S DIE="^OR(100.21,"
  1.  S DA=+TEAM
  1.  S DR="1.7  Enter subscription status: "
  1.  D ^DIE ; Writes to SUBSCRIBE field.
  1.  K DIE
  1.  ;
  1.  Q
  1.  ;
  1. STOR ; From SEQ^ORLP0 - store list in 100.21.
  1.  Q:'$D(DUZ)!('ORCNT)
  1.  I '$D(TEAM),($D(Y)#2) S TEAM=Y
  1.  S DLAYGO=100.21
  1.  L +^OR(100.21,+TEAM)
  1.  S (CNT,ORLI)=0 F ORLJ=1:1 S ORLI=$O(^XUTL("OR",$J,"ORLP",ORLI)) Q:ORLI<1  I $D(^(ORLI,0)) S X=^(0),X=$P(X,U,3) D ADDLOOP
  1.  I $G(X)>0 S MSG=$S(CNT=0:"       Patient(s) already on list.",1:"       "_CNT_" patient(s) added.") W !?5,MSG
  1.  E  W !?5,"       No patients found."
  1.  I CNT>0 W !?5,"  Storing list " W:$D(TEAM) $P(TEAM,U,2)," " W "for future reference..."
  1.  L -^OR(100.12,+TEAM)
  1.  Q
  1.  ;
  1. ADDLOOP ; From STOR, LOOPTS - add patients.
  1.  Q:$D(^OR(100.21,+TEAM,10,"B",X))  ; Quit if on list.
  1.  S:'$D(^OR(100.21,+TEAM,10,0)) ^(0)="^100.2101AV^^"
  1.  K DIC,DA,DO,DD
  1.  S DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L"
  1.  D FILE^DICN I Y>0 S:$D(CNT) CNT=CNT+1
  1.  Q
  1.  ;
  1. CHKNAM(X) ; Check for duplicate entry.
  1.  N DIC
  1.  S X=$G(X)
  1.  S DIC="^OR(100.21,"
  1.  D ^DIC
  1.  S X=+Y
  1.  Q X
  1.  ;
  1. END ;
  1.  I $G(TEAM) L -^OR(100.21,+TEAM)
  1.  ;
  1. END1 K %,CNT,DA,DD,DIC,DO,DIE,DIK,DIR,DR,LINK,ORCNT,ORLI,ORLJ,ORLPT,SEL,TEAM,X,Y,ORBSTG,ORBROOT,DTOUT
  1.  Q
  1.  ;