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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLP3AC1 5224 printed Nov 22, 2024@17:41:20 Page 2
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
+2 ;
+3 ; Called by: ORLP3AUC.
+4 ;
ADD ; Add patient to applicable team lists.
+1 ;
+2 ; Variables used -
+3 ;
+4 ; NEW'd and assigned by calling tag (ORLP3AUC):
+5 ;
+6 ; ORTL = OE/RR TEAM LIST file number (set to "100.21").
+7 ; ORCL = Clinic.
+8 ; ORPT = Patient number.
+9 ;
+10 ; NEW'd herein:
+11 ;
+12 ; ORTEAM = Team List.
+13 ; ORAL = Team List Autolink.
+14 ; ORVAL = Team List Autolink node data value.
+15 ; ORTYPE = Type of Autolink.
+16 ; X = Required variable for call to FILE^DICN.
+17 ;
+18 NEW ORTEAM,ORAL,ORVAL,ORTYPE,X
+19 ;
+20 ; Order through OE/RR TEAM LIST file looking for clinic autolinks:
+21 ; Initialize.
SET ORTEAM=0
+22 ; Each team.
FOR
SET ORTEAM=$ORDER(^OR(ORTL,ORTEAM))
if '+ORTEAM
QUIT
Begin DoDot:1
+23 ; If not an Autolink Team List or no Autolink records, skip.
IF $PIECE(^OR(ORTL,ORTEAM,0),"^",2)["A"
IF '$ORDER(^OR(ORTL,ORTEAM,2,0))
QUIT
+24 ; Initialize.
SET ORAL=0
+25 ; Each Autolink.
FOR
SET ORAL=$ORDER(^OR(ORTL,ORTEAM,2,ORAL))
if '+ORAL
QUIT
Begin DoDot:2
+26 ; Get data value from this clinic's record.
IF $DATA(^OR(ORTL,ORTEAM,2,ORAL,0))
SET ORVAL=^OR(ORTL,ORTEAM,2,ORAL,0)
+27 ; Get Autolink type.
SET ORTYPE=$PIECE(ORVAL,";",2)
+28 ; Is the Autolink type a clinic?
IF ORTYPE="SC("
Begin DoDot:3
+29 ; Is it the clinic involved?
IF $PIECE(ORVAL,";")=ORCL
Begin DoDot:4
+30 ; Patient already there?
IF $DATA(^OR(ORTL,ORTEAM,10,"B",ORPT_";DPT("))
QUIT
+31 ;
+32 ; Lock the records at the Team level:
+33 LOCK +^OR(ORTL,+ORTEAM):5
+34 ; Skip this Team if there's a locking problem.
IF '$TEST
WRITE !," WARNING: File locked - "_$PIECE($GET(^OR(ORTL,+ORTEAM,0)),"^")_" Team List not updated."
QUIT
+35 ;
+36 ; Set variables and call tag^routine that invokes DICN call:
+37 if '$DATA(^OR(ORTL,+ORTEAM,10,0))
SET ^(0)="^100.2101AV^^"
+38 KILL DIC,DA,DO,DD,X
+39 SET X=ORPT_";DPT("
+40 SET DIC(0)="L"
+41 SET DA(1)=+ORTEAM
+42 SET DIC="^OR("_ORTL_","_DA(1)_",10,"
+43 DO FILE^DICN
+44 ; Release the lock on this Team.
LOCK -^OR(ORTL,+ORTEAM)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+45 ;
+46 QUIT
+47 ;
DELETE ; Delete patient from team lists if appropriate. (Patient
+1 ; not removed if another autolink would list him/her.)
+2 ;
+3 ; Variables used -
+4 ;
+5 ; NEW'd and assigned by calling tag (ORLP3AUC):
+6 ;
+7 ; ORTL = OE/RR TEAM LIST file number (set to "100.21").
+8 ; ORCL = Clinic.
+9 ; ORPT = Patient number.
+10 ;
+11 ; NEW'd herein (or in BLDDEL tag called herein):
+12 ;
+13 ; ORTEAM = Team List.
+14 ; ORAL = Team List Autolink.
+15 ; ORVAL = Team List Autolink node data value.
+16 ; ORTYPE = Type of Autolink.
+17 ; ORLINK = Autolink holder variable.
+18 ; LNAME = Team List textual name.
+19 ; VP = Array for call to PTS^ORLP2.
+20 ;
+21 NEW ORTEAM,ORAL,ORVAL,ORTYPE,ORLINK,LNAME,VP
+22 ;
+23 ; Order through OE/RR TEAM LIST file looking for autolinks:
+24 ;
+25 ; Initialize.
SET ORTEAM=0
+26 ; Each team.
FOR
SET ORTEAM=$ORDER(^OR(ORTL,ORTEAM))
if '+ORTEAM
QUIT
Begin DoDot:1
+27 ; If not an Autolink Team List or no Autolink records, skip.
IF $PIECE(^OR(ORTL,ORTEAM,0),"^",2)["A"
IF '$ORDER(^OR(ORTL,ORTEAM,2,0))
QUIT
+28 ; Initialize.
SET ORAL=0
+29 ; Each Autolink.
FOR
SET ORAL=$ORDER(^OR(ORTL,ORTEAM,2,ORAL))
if '+ORAL
QUIT
Begin DoDot:2
+30 ; Get data value from this clinic's record.
IF $DATA(^OR(ORTL,ORTEAM,2,ORAL,0))
SET ORVAL=^OR(ORTL,ORTEAM,2,ORAL,0)
+31 ; Get Autolink type.
SET ORTYPE=$PIECE(ORVAL,";",2)
+32 ; Is the Autolink type a clinic?
IF ORTYPE="SC("
Begin DoDot:3
+33 ; Is it the clinic involved?
IF $PIECE(ORVAL,";")=ORCL
Begin DoDot:4
+34 ; Patient Autolinked there now? If not, forget it.
IF '$DATA(^OR(ORTL,ORTEAM,10,"B",ORPT_";DPT("))
QUIT
+35 ; Call tag to build list/compare/delete entry if needed.
DO BLDDEL
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+36 ;
+37 QUIT
+38 ;
BLDDEL ; Build ^TMP, delete patient from clinic Autolinks as appropriate.
+1 ;
+2 ; Build ^TMP global of all patients that would be on list
+3 ; because of remaining Autolinks for this Team -
+4 ;
+5 ; "Just-in-case" clean up.
KILL VP,^TMP("ORLP",$JOB)
+6 ;
+7 ; Set variables for call to DIC:
+8 SET DIC(0)="NZ"
+9 SET DA(1)=+ORTEAM
+10 SET DIC="^OR("_ORTL_","_DA(1)_",2,"
+11 ;
+12 ; Order through Autolinks of this Team for remaining Autolinks:
+13 ; Initialize.
SET ORLINK=0
+14 FOR
SET ORLINK=$ORDER(^OR(ORTL,+ORTEAM,2,ORLINK))
if 'ORLINK
QUIT
Begin DoDot:1
+15 ; Skip clinic that triggered delete action - patient already there by default.
IF $GET(^OR(ORTL,+ORTEAM,2,ORLINK,0))=ORCL_";SC("
QUIT
+16 SET X="`"_ORLINK
+17 DO ^DIC
+18 SET VP=Y(0)
+19 SET VP(1)="^"_$PIECE($PIECE(VP,";",2),"^")
+20 SET VP(2)=+VP
+21 SET LNAME=Y(0,0)
+22 ; Call tag^routine to add patients to ^TMP.
DO PTS^ORLP2(.VP,"LINK")
End DoDot:1
+23 ; Clean up pre-DIC.
KILL X,Y,DIC
+24 ;
+25 ; If patient is on list because of other autolinks, leave
+26 ; him/her there - otherwise delete the patient entry:
+27 ; Patient not on list?
IF '$DATA(^TMP("ORLP",$JOB,"LINK",ORPT))
Begin DoDot:1
+28 ;
+29 ; Lock the records at the Team level:
+30 LOCK +^OR(ORTL,+ORTEAM):5
+31 ; Skip this Team if there's a locking problem.
IF '$TEST
WRITE !," WARNING: File locked - "_LNAME_" Team List not updated."
QUIT
+32 ;
+33 SET DA=$ORDER(^OR(ORTL,+ORTEAM,10,"B",ORPT_";DPT(",0))
+34 IF DA
Begin DoDot:2
+35 SET DA(1)=+ORTEAM
+36 SET DIK="^OR("_ORTL_","_DA(1)_",10,"
+37 DO ^DIK
+38 ; Clean up DIK.
KILL DIK
End DoDot:2
+39 ;
+40 ; Release the lock on this Team.
LOCK -^OR(ORTL,+ORTEAM)
End DoDot:1
+41 ;
+42 ; Clean up before quitting.
KILL VP,^TMP("ORLP",$JOB)
+43 QUIT
+44 ;
