- 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
- ;
- 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 ;
