source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLP3AC1.m

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