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

ORLP3AC1.m

Go to the documentation of this file. 
  1. ORLP3AC1 ; SLC/PKS - ADD and DELETE a patient to clinic Team List Autolinks.  [12/28/99 2:48pm]
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**47**;Dec 17, 1997
  1.  ;
  1.  ; Called by: ORLP3AUC.
  1.  ;
  1. ADD ; Add patient to applicable team lists.
  1.  ;
  1.  ; Variables used -
  1.  ;
  1.  ;    NEW'd and assigned by calling tag (ORLP3AUC):
  1.  ;
  1.  ;       ORTL   = OE/RR TEAM LIST file number (set to "100.21").
  1.  ;       ORCL   = Clinic.
  1.  ;       ORPT   = Patient number.
  1.  ;
  1.  ;    NEW'd herein:
  1.  ;
  1.  ;       ORTEAM = Team List.
  1.  ;       ORAL   = Team List Autolink.
  1.  ;       ORVAL  = Team List Autolink node data value.
  1.  ;       ORTYPE = Type of Autolink.
  1.  ;       X      = Required variable for call to FILE^DICN.
  1.  ;
  1.  N ORTEAM,ORAL,ORVAL,ORTYPE,X
  1.  ;
  1.  ; Order through OE/RR TEAM LIST file looking for clinic autolinks:
  1.  S ORTEAM=0 ; Initialize.
  1.  F  S ORTEAM=$O(^OR(ORTL,ORTEAM)) Q:'+ORTEAM  D      ; Each team.
  1.  .I $P(^OR(ORTL,ORTEAM,0),"^",2)["A",'$O(^OR(ORTL,ORTEAM,2,0)) Q  ; If not an Autolink Team List or no Autolink records, skip.
  1.  .S ORAL=0 ; Initialize.
  1.  .F  S ORAL=$O(^OR(ORTL,ORTEAM,2,ORAL)) Q:'+ORAL  D  ; Each Autolink.
  1.  ..I $D(^OR(ORTL,ORTEAM,2,ORAL,0)) S ORVAL=^OR(ORTL,ORTEAM,2,ORAL,0) ; Get data value from this clinic's record.
  1.  ..S ORTYPE=$P(ORVAL,";",2) ; Get Autolink type.
  1.  ..I ORTYPE="SC(" D         ; Is the Autolink type a clinic?
  1.  ...I $P(ORVAL,";")=ORCL D  ; Is it the clinic involved?
  1.  ....I $D(^OR(ORTL,ORTEAM,10,"B",ORPT_";DPT(")) Q  ; Patient already there?
  1.  ....;
  1.  ....; Lock the records at the Team level:
  1.  ....L +^OR(ORTL,+ORTEAM):5
  1.  ....I '$T W !,"  WARNING: File locked - "_$P($G(^OR(ORTL,+ORTEAM,0)),"^")_" Team List not updated." Q  ; Skip this Team if there's a locking problem.
  1.  ....;
  1.  ....; Set variables and call tag^routine that invokes DICN call:
  1.  ....S:'$D(^OR(ORTL,+ORTEAM,10,0)) ^(0)="^100.2101AV^^"
  1.  ....K DIC,DA,DO,DD,X
  1.  ....S X=ORPT_";DPT("
  1.  ....S DIC(0)="L"
  1.  ....S DA(1)=+ORTEAM
  1.  ....S DIC="^OR("_ORTL_","_DA(1)_",10,"
  1.  ....D FILE^DICN
  1.  ....L -^OR(ORTL,+ORTEAM) ; Release the lock on this Team.
  1.  ;
  1.  Q
  1.  ;
  1. DELETE ; Delete patient from team lists if appropriate.  (Patient
  1.  ;    not removed if another autolink would list him/her.)
  1.  ;
  1.  ; Variables used -
  1.  ;
  1.  ;    NEW'd and assigned by calling tag (ORLP3AUC):
  1.  ;
  1.  ;       ORTL   = OE/RR TEAM LIST file number (set to "100.21").
  1.  ;       ORCL   = Clinic.
  1.  ;       ORPT   = Patient number.
  1.  ;
  1.  ;    NEW'd herein (or in BLDDEL tag called herein):
  1.  ;
  1.  ;       ORTEAM = Team List.
  1.  ;       ORAL   = Team List Autolink.
  1.  ;       ORVAL  = Team List Autolink node data value.
  1.  ;       ORTYPE = Type of Autolink.
  1.  ;       ORLINK = Autolink holder variable.
  1.  ;       LNAME  = Team List textual name.
  1.  ;       VP     = Array for call to PTS^ORLP2.
  1.  ;
  1.  N ORTEAM,ORAL,ORVAL,ORTYPE,ORLINK,LNAME,VP
  1.  ;
  1.  ; Order through OE/RR TEAM LIST file looking for autolinks:
  1.  ;
  1.  S ORTEAM=0 ; Initialize.
  1.  F  S ORTEAM=$O(^OR(ORTL,ORTEAM)) Q:'+ORTEAM  D      ; Each team.
  1.  .I $P(^OR(ORTL,ORTEAM,0),"^",2)["A",'$O(^OR(ORTL,ORTEAM,2,0)) Q  ; If not an Autolink Team List or no Autolink records, skip.
  1.  .S ORAL=0 ; Initialize.
  1.  .F  S ORAL=$O(^OR(ORTL,ORTEAM,2,ORAL)) Q:'+ORAL  D  ; Each Autolink.
  1.  ..I $D(^OR(ORTL,ORTEAM,2,ORAL,0)) S ORVAL=^OR(ORTL,ORTEAM,2,ORAL,0) ; Get data value from this clinic's record.
  1.  ..S ORTYPE=$P(ORVAL,";",2) ; Get Autolink type.
  1.  ..I ORTYPE="SC(" D         ; Is the Autolink type a clinic?
  1.  ...I $P(ORVAL,";")=ORCL D  ; Is it the clinic involved?
  1.  ....I '$D(^OR(ORTL,ORTEAM,10,"B",ORPT_";DPT(")) Q  ; Patient Autolinked there now?  If not, forget it.
  1.  ....D BLDDEL ; Call tag to build list/compare/delete entry if needed.
  1.  ;
  1.  Q
  1.  ;
  1. BLDDEL ; Build ^TMP, delete patient from clinic Autolinks as appropriate.
  1.  ;
  1.  ; Build ^TMP global of all patients that would be on list 
  1.  ;    because of remaining Autolinks for this Team -
  1.  ;
  1.  K VP,^TMP("ORLP",$J) ; "Just-in-case" clean up.
  1.  ;
  1.  ; Set variables for call to DIC:
  1.  S DIC(0)="NZ"
  1.  S DA(1)=+ORTEAM
  1.  S DIC="^OR("_ORTL_","_DA(1)_",2,"
  1.  ;
  1.  ; Order through Autolinks of this Team for remaining Autolinks:
  1.  S ORLINK=0 ; Initialize.
  1.  F  S ORLINK=$O(^OR(ORTL,+ORTEAM,2,ORLINK)) Q:'ORLINK  D
  1.  .I $G(^OR(ORTL,+ORTEAM,2,ORLINK,0))=ORCL_";SC(" Q  ; Skip clinic that triggered delete action - patient already there by default.
  1.  .S X="`"_ORLINK
  1.  .D ^DIC
  1.  .S VP=Y(0)
  1.  .S VP(1)="^"_$P($PIECE(VP,";",2),"^")
  1.  .S VP(2)=+VP
  1.  .S LNAME=Y(0,0)
  1.  .D PTS^ORLP2(.VP,"LINK") ; Call tag^routine to add patients to ^TMP.
  1.  K X,Y,DIC ; Clean up pre-DIC.
  1.  ;
  1.  ; If patient is on list because of other autolinks, leave
  1.  ;    him/her there - otherwise delete the patient entry:
  1.  I '$D(^TMP("ORLP",$J,"LINK",ORPT)) D  ; Patient not on list?
  1.  .;
  1.  .; Lock the records at the Team level:
  1.  .L +^OR(ORTL,+ORTEAM):5
  1.  .I '$T W !,"  WARNING: File locked - "_LNAME_" Team List not updated." Q  ; Skip this Team if there's a locking problem.
  1.  .;
  1.  .S DA=$O(^OR(ORTL,+ORTEAM,10,"B",ORPT_";DPT(",0))
  1.  .I DA D
  1.  ..S DA(1)=+ORTEAM
  1.  ..S DIK="^OR("_ORTL_","_DA(1)_",10,"
  1.  ..D ^DIK
  1.  ..K DIK               ; Clean up DIK.
  1.  .;
  1.  .L -^OR(ORTL,+ORTEAM) ; Release the lock on this Team.
  1.  ;
  1.  K VP,^TMP("ORLP",$J)  ; Clean up before quitting.
  1.  Q
  1.  ;