source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLP3AC1.m@ 861

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

 ;