ORLP3AUC ; SLC/CLA - Automatically load clinic patients into team lists ;9/11/96 [12/28/99 2:45pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,47**;Dec 17, 1997
; Re-created by PKS, 7/99.
;
; This code checks the ^TMP file that is written by the
; SC CLINIC ENROLL/DISCHARGE EVENT DRIVER protocol. That
; protocol in turn calls the protocol ORU AUTOLIST CLINIC,
; which calls this routine. When control is returned to
; SC CLINIC ENROLL/DISCHARGE EVENT DRIVER, the ^TMP entries
; are deleted. They can be viewed by breaking out before
; that point for testing [^TMP($J,"SC CED")].
;
; (NOTE: At the time of re-creation of this routine, existing code
; would not allow a user to enter a clinic enrollment or clinic
; discharge date later than the current day. Thus, no post-date
; checking is included in this routine.)
;
EN ; Called by protocol: ORU AUTOLIST CLINIC. Updates Team Lists
; where the Autolink is a clinic.
;
; Variables used -
;
; By tags called (in ORLP3AC1):
;
; ORTL = OE/RR TEAM LIST file.
; 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.
;
; By this tag (and by tags called as needed):
;
; ORPT = Patient number.
; ORBARY = Array of "B" index clinics.
; ORCL = Clinic.
; ORBRCD = "BEFORE" clinic record number.
; ORARCD = "AFTER" clinic record number.
; ORBLAST = Last record in ^TMP file for "BEFORE" clinic.
; ORALAST = Last record in ^TMP file for "AFTER" clinic.
; ORBEFORE = Data in "BEFORE" record.
; ORAFTER = Data in "AFTER" record.
; ORBEDATE = "BEFORE" clinic enrollment date.
; ORBDDATE = "BEFORE" clinic discharge date.
; ORAEDATE = "AFTER" clinic enrollment date.
; ORADDATE = "AFTER" clinic discharge date.
;
N ORTL,ORPT,ORBARY,ORCL,ORBRCD,ORARCD,ORBLAST,ORALAST,ORBEFORE,ORAFTER,ORBEDATE,ORBDDATE,ORAEDATE,ORADDATE
S ORTL="100.21" ; Assign for use by ADD and DELETE tags.
;
; Check for existence of ^TMP entries:
I '$D(^TMP($J,"SC CED")) Q
;
; Process each patient in the ^TMP file:
S ORPT=0 ; Initialize.
F S ORPT=$O(^TMP($J,"SC CED",ORPT)) Q:'ORPT D
.;
.; Build an array of clinics for each patient in the ^TMP file:
.K ORBARY ; Clean up each time through.
.;
.; Order through the "B" index records for this patient:
.S ORCL=0 ; Initialize.
.F S ORCL=$O(^TMP($J,"SC CED",ORPT,"BEFORE","B",ORCL)) Q:'+ORCL DO ; Each "BEFORE" "B" record for clinics.
..S ORBARY(ORCL)="" ; Set array element for each "BEFORE" clinic.
.S ORCL=0 ; Re-initialize.
.F S ORCL=$O(^TMP($J,"SC CED",ORPT,"AFTER","B",ORCL)) Q:'+ORCL D ; Each "AFTER" "B" record for clinics.
..S ORBARY(ORCL)="" ; Set array element for each "AFTER" clinic.
.; The previous array should contain only one entry for each clinic,
.; whether from "BEFORE" or "AFTER" entries - (dupes overwritten).
.;
.; Check for valid data again:
.I '$D(ORBARY) Q ; If nothing to process, done.
.;
.; Write data entries for "BEFORE" and "AFTER" based on ^TMP data:
.S ORCL=0 ; Initialize.
.F S ORCL=$O(ORBARY(ORCL)) Q:'+ORCL D ; Array entries.
..I $D(^TMP($J,"SC CED",ORPT,"BEFORE","B",ORCL)) S ORBARY(ORCL)=$O(^TMP($J,"SC CED",ORPT,"BEFORE","B",ORCL,"")) ; Set array element to ^TMP "BEFORE" "B" x-ref record number.
..S ORBARY(ORCL)=ORBARY(ORCL)_"^" ; Add delimiter.
..I $D(^TMP($J,"SC CED",ORPT,"AFTER","B",ORCL)) S ORBARY(ORCL)=ORBARY(ORCL)_$O(^TMP($J,"SC CED",ORPT,"AFTER","B",ORCL,"")) ; Set array element to ^TMP "AFTER" "B" x-ref record number.
.;
.; Array entries like the following should now exist:
.;
.; ORBARY(5)=1^1 | Clinic 5 has "BEFORE" and "AFTER" entries.
.; ORBARY(16)=^3 | Clinic 16 has only an "AFTER" entry.
.; (Etc.)
.; ORBARY(11)=2^ | No "AFTER" entry - should never happen!
.;
.; Process each clinic listed for this patient:
.S ORCL=0 ; Initialize.
.F S ORCL=$O(ORBARY(ORCL)) Q:'+ORCL D ; Each clinic.
..;
..; Check for no "AFTER" records:
..;I $P($G(ORBARY(ORCL)),"^",2)="" Q ; Shouldn't happen!
..;
..; Get "BEFORE" and "AFTER" record entries for this clinic:
..S ORBRCD="",ORARCD="" ; Initialize.
..S ORBRCD=$P(ORBARY(ORCL),"^") ; Assign "BEFORE" record number, if any.
..S ORARCD=$P(ORBARY(ORCL),"^",2) ; Assign "AFTER" record number, if any.
..;
..; Find the last records for each case, as applicable:
..S ORBLAST="",ORALAST="" ; Initialize.
..I $G(ORBRCD) S ORBLAST=$O(^TMP($J,"SC CED",ORPT,"BEFORE",ORBRCD,1,ORBLAST),-1) ; Last "BEFORE" record.
..I $G(ORARCD) S ORALAST=$O(^TMP($J,"SC CED",ORPT,"AFTER",ORARCD,1,ORALAST),-1) ; Last "AFTER" record.
..;
..; Get BEFORE and AFTER data from last records for each clinic:
..S ORBEFORE="",ORAFTER="" ; Initialize.
..I $G(ORBLAST) S ORBEFORE=$G(^TMP($J,"SC CED",ORPT,"BEFORE",ORBRCD,1,ORBLAST,0)) ; Get "BEFORE" data.
..I $G(ORALAST) S ORAFTER=$G(^TMP($J,"SC CED",ORPT,"AFTER",ORARCD,1,ORALAST,0)) ; Get "AFTER" data.
..;
..; With "BEFORE" and "AFTER" data, process Team Lists -
..;
..; If no changes, there's nothing to do for this clinic:
..I ORBEFORE=ORAFTER Q
..;
..; Get date information in each case as applicable:
..S ORBEDATE=$P($G(ORBEFORE),"^") ; "BEFORE" enroll date.
..S ORBEDATE=$P($G(ORBEDATE),".") ; Remove time, if any.
..S ORBDDATE=$P($G(ORBEFORE),"^",3) ; "BEFORE" d/c date.
..S ORAEDATE=$P($G(ORAFTER),"^") ; "AFTER" date.
..S ORAEDATE=$P($G(ORAEDATE),".") ; Remove time, if any.
..S ORADDATE=$P($G(ORAFTER),"^",3) ; "AFTER" d/c date.
..; (All four dates should now be set, even if to null.)
..;
..; Now call the ADD or DELETE tags in ORLP3AC1 as appropriate -
..;
..; If no "AFTER" d/c and enroll <> "BEFORE" enroll, call add:
..I (ORADDATE="")&(ORAEDATE'=ORBEDATE) D ADD^ORLP3AC1
..;
..; If "AFTER" d/c exists and <> "BEFORE" d/c, call delete:
..I (ORADDATE'="")&(ORADDATE'=ORBDDATE) D DELETE^ORLP3AC1
;
K ORBARY ; Clean up.
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLP3AUC 6333 printed Apr 09, 2024@21:26:51 Page 2
ORLP3AUC ; SLC/CLA - Automatically load clinic patients into team lists ;9/11/96 [12/28/99 2:45pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,47**;Dec 17, 1997
+2 ; Re-created by PKS, 7/99.
+3 ;
+4 ; This code checks the ^TMP file that is written by the
+5 ; SC CLINIC ENROLL/DISCHARGE EVENT DRIVER protocol. That
+6 ; protocol in turn calls the protocol ORU AUTOLIST CLINIC,
+7 ; which calls this routine. When control is returned to
+8 ; SC CLINIC ENROLL/DISCHARGE EVENT DRIVER, the ^TMP entries
+9 ; are deleted. They can be viewed by breaking out before
+10 ; that point for testing [^TMP($J,"SC CED")].
+11 ;
+12 ; (NOTE: At the time of re-creation of this routine, existing code
+13 ; would not allow a user to enter a clinic enrollment or clinic
+14 ; discharge date later than the current day. Thus, no post-date
+15 ; checking is included in this routine.)
+16 ;
EN ; Called by protocol: ORU AUTOLIST CLINIC. Updates Team Lists
+1 ; where the Autolink is a clinic.
+2 ;
+3 ; Variables used -
+4 ;
+5 ; By tags called (in ORLP3AC1):
+6 ;
+7 ; ORTL = OE/RR TEAM LIST file.
+8 ; ORTEAM = Team List.
+9 ; ORAL = Team List Autolink.
+10 ; ORVAL = Team List Autolink node data value.
+11 ; ORTYPE = Type of Autolink.
+12 ; ORLINK = Autolink holder variable.
+13 ; LNAME = Team List textual name.
+14 ; VP = Array for call to PTS^ORLP2.
+15 ;
+16 ; By this tag (and by tags called as needed):
+17 ;
+18 ; ORPT = Patient number.
+19 ; ORBARY = Array of "B" index clinics.
+20 ; ORCL = Clinic.
+21 ; ORBRCD = "BEFORE" clinic record number.
+22 ; ORARCD = "AFTER" clinic record number.
+23 ; ORBLAST = Last record in ^TMP file for "BEFORE" clinic.
+24 ; ORALAST = Last record in ^TMP file for "AFTER" clinic.
+25 ; ORBEFORE = Data in "BEFORE" record.
+26 ; ORAFTER = Data in "AFTER" record.
+27 ; ORBEDATE = "BEFORE" clinic enrollment date.
+28 ; ORBDDATE = "BEFORE" clinic discharge date.
+29 ; ORAEDATE = "AFTER" clinic enrollment date.
+30 ; ORADDATE = "AFTER" clinic discharge date.
+31 ;
+32 NEW ORTL,ORPT,ORBARY,ORCL,ORBRCD,ORARCD,ORBLAST,ORALAST,ORBEFORE,ORAFTER,ORBEDATE,ORBDDATE,ORAEDATE,ORADDATE
+33 ; Assign for use by ADD and DELETE tags.
SET ORTL="100.21"
+34 ;
+35 ; Check for existence of ^TMP entries:
+36 IF '$DATA(^TMP($JOB,"SC CED"))
QUIT
+37 ;
+38 ; Process each patient in the ^TMP file:
+39 ; Initialize.
SET ORPT=0
+40 FOR
SET ORPT=$ORDER(^TMP($JOB,"SC CED",ORPT))
if 'ORPT
QUIT
Begin DoDot:1
+41 ;
+42 ; Build an array of clinics for each patient in the ^TMP file:
+43 ; Clean up each time through.
KILL ORBARY
+44 ;
+45 ; Order through the "B" index records for this patient:
+46 ; Initialize.
SET ORCL=0
+47 ; Each "BEFORE" "B" record for clinics.
FOR
SET ORCL=$ORDER(^TMP($JOB,"SC CED",ORPT,"BEFORE","B",ORCL))
if '+ORCL
QUIT
Begin DoDot:2
+48 ; Set array element for each "BEFORE" clinic.
SET ORBARY(ORCL)=""
End DoDot:2
+49 ; Re-initialize.
SET ORCL=0
+50 ; Each "AFTER" "B" record for clinics.
FOR
SET ORCL=$ORDER(^TMP($JOB,"SC CED",ORPT,"AFTER","B",ORCL))
if '+ORCL
QUIT
Begin DoDot:2
+51 ; Set array element for each "AFTER" clinic.
SET ORBARY(ORCL)=""
End DoDot:2
+52 ; The previous array should contain only one entry for each clinic,
+53 ; whether from "BEFORE" or "AFTER" entries - (dupes overwritten).
+54 ;
+55 ; Check for valid data again:
+56 ; If nothing to process, done.
IF '$DATA(ORBARY)
QUIT
+57 ;
+58 ; Write data entries for "BEFORE" and "AFTER" based on ^TMP data:
+59 ; Initialize.
SET ORCL=0
+60 ; Array entries.
FOR
SET ORCL=$ORDER(ORBARY(ORCL))
if '+ORCL
QUIT
Begin DoDot:2
+61 ; Set array element to ^TMP "BEFORE" "B" x-ref record number.
IF $DATA(^TMP($JOB,"SC CED",ORPT,"BEFORE","B",ORCL))
SET ORBARY(ORCL)=$ORDER(^TMP($JOB,"SC CED",ORPT,"BEFORE","B",ORCL,""))
+62 ; Add delimiter.
SET ORBARY(ORCL)=ORBARY(ORCL)_"^"
+63 ; Set array element to ^TMP "AFTER" "B" x-ref record number.
IF $DATA(^TMP($JOB,"SC CED",ORPT,"AFTER","B",ORCL))
SET ORBARY(ORCL)=ORBARY(ORCL)_$ORDER(^TMP($JOB,"SC CED",ORPT,"AFTER","B",ORCL,""))
End DoDot:2
+64 ;
+65 ; Array entries like the following should now exist:
+66 ;
+67 ; ORBARY(5)=1^1 | Clinic 5 has "BEFORE" and "AFTER" entries.
+68 ; ORBARY(16)=^3 | Clinic 16 has only an "AFTER" entry.
+69 ; (Etc.)
+70 ; ORBARY(11)=2^ | No "AFTER" entry - should never happen!
+71 ;
+72 ; Process each clinic listed for this patient:
+73 ; Initialize.
SET ORCL=0
+74 ; Each clinic.
FOR
SET ORCL=$ORDER(ORBARY(ORCL))
if '+ORCL
QUIT
Begin DoDot:2
+75 ;
+76 ; Check for no "AFTER" records:
+77 ;I $P($G(ORBARY(ORCL)),"^",2)="" Q ; Shouldn't happen!
+78 ;
+79 ; Get "BEFORE" and "AFTER" record entries for this clinic:
+80 ; Initialize.
SET ORBRCD=""
SET ORARCD=""
+81 ; Assign "BEFORE" record number, if any.
SET ORBRCD=$PIECE(ORBARY(ORCL),"^")
+82 ; Assign "AFTER" record number, if any.
SET ORARCD=$PIECE(ORBARY(ORCL),"^",2)
+83 ;
+84 ; Find the last records for each case, as applicable:
+85 ; Initialize.
SET ORBLAST=""
SET ORALAST=""
+86 ; Last "BEFORE" record.
IF $GET(ORBRCD)
SET ORBLAST=$ORDER(^TMP($JOB,"SC CED",ORPT,"BEFORE",ORBRCD,1,ORBLAST),-1)
+87 ; Last "AFTER" record.
IF $GET(ORARCD)
SET ORALAST=$ORDER(^TMP($JOB,"SC CED",ORPT,"AFTER",ORARCD,1,ORALAST),-1)
+88 ;
+89 ; Get BEFORE and AFTER data from last records for each clinic:
+90 ; Initialize.
SET ORBEFORE=""
SET ORAFTER=""
+91 ; Get "BEFORE" data.
IF $GET(ORBLAST)
SET ORBEFORE=$GET(^TMP($JOB,"SC CED",ORPT,"BEFORE",ORBRCD,1,ORBLAST,0))
+92 ; Get "AFTER" data.
IF $GET(ORALAST)
SET ORAFTER=$GET(^TMP($JOB,"SC CED",ORPT,"AFTER",ORARCD,1,ORALAST,0))
+93 ;
+94 ; With "BEFORE" and "AFTER" data, process Team Lists -
+95 ;
+96 ; If no changes, there's nothing to do for this clinic:
+97 IF ORBEFORE=ORAFTER
QUIT
+98 ;
+99 ; Get date information in each case as applicable:
+100 ; "BEFORE" enroll date.
SET ORBEDATE=$PIECE($GET(ORBEFORE),"^")
+101 ; Remove time, if any.
SET ORBEDATE=$PIECE($GET(ORBEDATE),".")
+102 ; "BEFORE" d/c date.
SET ORBDDATE=$PIECE($GET(ORBEFORE),"^",3)
+103 ; "AFTER" date.
SET ORAEDATE=$PIECE($GET(ORAFTER),"^")
+104 ; Remove time, if any.
SET ORAEDATE=$PIECE($GET(ORAEDATE),".")
+105 ; "AFTER" d/c date.
SET ORADDATE=$PIECE($GET(ORAFTER),"^",3)
+106 ; (All four dates should now be set, even if to null.)
+107 ;
+108 ; Now call the ADD or DELETE tags in ORLP3AC1 as appropriate -
+109 ;
+110 ; If no "AFTER" d/c and enroll <> "BEFORE" enroll, call add:
+111 IF (ORADDATE="")&(ORAEDATE'=ORBEDATE)
DO ADD^ORLP3AC1
+112 ;
+113 ; If "AFTER" d/c exists and <> "BEFORE" d/c, call delete:
+114 IF (ORADDATE'="")&(ORADDATE'=ORBDDATE)
DO DELETE^ORLP3AC1
End DoDot:2
End DoDot:1
+115 ;
+116 ; Clean up.
KILL ORBARY
+117 QUIT
+118 ;
