PXRRPASA ;ISL/PKR - Build and sort a list of appointments. ; 6/27/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**18**;Aug 12, 1996
;
SORT ;
N BD,BUSY,CLINIEN,DFN,DONE,ED
N IC,JC,FAC,FACILITY,FACNAM
N HLOCIEN,POV,STATUS
N TEMP
;
;Allow the task to be cleaned up upon successful completion.
S ZTREQ="@"
;
I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
;
;Build a list of hospital locations to be included in the report.
S TEMP=$P($G(PXRRLCSC),U,1)
;
;Check for selected hospital locations.
I TEMP="HS" D
. F IC=1:1:NHL D
.. S HLOCIEN=$P(PXRRLCHL(IC),U,2)
.. S FACILITY=$P(^SC(HLOCIEN,0),U,4)
.. I $$FACCHECK(FACILITY) D
... S ^TMP(PXRRXTMP,$J,"HLOC",FACILITY,HLOCIEN)=""
;
;Check for selected clinics.
I TEMP="CS" D
. S IC=0
. F S IC=$O(^SC(IC)) Q:+IC=0 D
.. S DONE=0
.. S CLINIEN=$P(^SC(IC,0),U,7)
.. I +CLINIEN>0 D
... F JC=1:1:NCS Q:DONE D
.... I CLINIEN=$P(PXRRCS(JC),U,2) D
..... S FACILITY=$P(^SC(IC,0),U,4)
..... I $$FACCHECK(FACILITY) S ^TMP(PXRRXTMP,$J,"HLOC",FACILITY,IC)=""
..... S DONE=1
;
;For all hospital locations or clinic stops we have to have
;all the locations in the file.
I (TEMP="HA")!(TEMP="CA") D
. S IC=0
. F S IC=$O(^SC(IC)) Q:+IC=0 D
.. S FACILITY=$P(^SC(IC,0),U,4)
.. I $$FACCHECK(FACILITY) D
... S ^TMP(PXRRXTMP,$J,"HLOC",FACILITY,IC)=""
;
;Build a list of appointments for each location.
S FAC=""
NFAC S FAC=$O(^TMP(PXRRXTMP,$J,"HLOC",FAC))
I FAC="" G APPDONE
;
S HLOCIEN=""
NHLOC S HLOCIEN=$O(^TMP(PXRRXTMP,$J,"HLOC",FAC,HLOCIEN))
I HLOCIEN="" G NFAC
;
;If this is an interactive session let the user know that something
;is happening.
;I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting appointments",.BUSY)
;
;Check for a user request to stop the task.
I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
;
S BD=PXRRBADT-.0001
S ED=PXRREADT+.2359
NDATE S BD=$O(^SC(HLOCIEN,"S",BD))
;If we have passed the ending date we are done.
I (BD>ED)!(BD="") G NHLOC
;
;If this is an interactive session let the user know that something
;is happening.
I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting appointments",.BUSY)
;
;At this point we have an appointment that can be added to the list.
S IC=0
F S IC=$O(^SC(HLOCIEN,"S",BD,1,IC)) Q:+IC=0 D
. S DFN=$P(^SC(HLOCIEN,"S",BD,1,IC,0),U,1)
. S POV=$P(^DPT(DFN,"S",BD,0),U,7)
. S STATUS=$P(^DPT(DFN,"S",BD,0),U,2)
. S ^XTMP(PXRRXTMP,"APPT",FAC,HLOCIEN,DFN,BD)=STATUS_U_POV
;
;Get the next appointment.
G NDATE
;
APPDONE ;
I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
EXIT ;
K ^TMP(PXRRXTMP)
;
;Build the list of patient activities.
I PXRRQUE D
.;Start the report that was queued but not scheduled.
. N DESC,ROUTINE,TASK
. S DESC="Patient Activity Report - patient activities"
. S ROUTINE="PAT^PXRRPAPI"
. S ZTDTH=$$NOW^XLFDT
. S TASK=^XTMP(PXRRXTMP,"PATZTSK")
. D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
E D PAT^PXRRPAPI
Q
;
;=======================================================================
FACCHECK(FAC,FACILITY) ;If FAC is on the list of facilities return true.
N IC,FOUND
S FOUND=0
F IC=1:1:NFAC Q:FOUND D
. I $P(PXRRFAC(IC),U,1)=FAC D
.. S FOUND=1
Q FOUND
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRPASA 3237 printed Apr 09, 2024@21:31:33 Page 2
PXRRPASA ;ISL/PKR - Build and sort a list of appointments. ; 6/27/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**18**;Aug 12, 1996
+2 ;
SORT ;
+1 NEW BD,BUSY,CLINIEN,DFN,DONE,ED
+2 NEW IC,JC,FAC,FACILITY,FACNAM
+3 NEW HLOCIEN,POV,STATUS
+4 NEW TEMP
+5 ;
+6 ;Allow the task to be cleaned up upon successful completion.
+7 SET ZTREQ="@"
+8 ;
+9 IF '(PXRRQUE!$DATA(IO("S")))
DO INIT^PXRRBUSY(.BUSY)
+10 ;
+11 ;Build a list of hospital locations to be included in the report.
+12 SET TEMP=$PIECE($GET(PXRRLCSC),U,1)
+13 ;
+14 ;Check for selected hospital locations.
+15 IF TEMP="HS"
Begin DoDot:1
+16 FOR IC=1:1:NHL
Begin DoDot:2
+17 SET HLOCIEN=$PIECE(PXRRLCHL(IC),U,2)
+18 SET FACILITY=$PIECE(^SC(HLOCIEN,0),U,4)
+19 IF $$FACCHECK(FACILITY)
Begin DoDot:3
+20 SET ^TMP(PXRRXTMP,$JOB,"HLOC",FACILITY,HLOCIEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 ;Check for selected clinics.
+23 IF TEMP="CS"
Begin DoDot:1
+24 SET IC=0
+25 FOR
SET IC=$ORDER(^SC(IC))
if +IC=0
QUIT
Begin DoDot:2
+26 SET DONE=0
+27 SET CLINIEN=$PIECE(^SC(IC,0),U,7)
+28 IF +CLINIEN>0
Begin DoDot:3
+29 FOR JC=1:1:NCS
if DONE
QUIT
Begin DoDot:4
+30 IF CLINIEN=$PIECE(PXRRCS(JC),U,2)
Begin DoDot:5
+31 SET FACILITY=$PIECE(^SC(IC,0),U,4)
+32 IF $$FACCHECK(FACILITY)
SET ^TMP(PXRRXTMP,$JOB,"HLOC",FACILITY,IC)=""
+33 SET DONE=1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 ;
+35 ;For all hospital locations or clinic stops we have to have
+36 ;all the locations in the file.
+37 IF (TEMP="HA")!(TEMP="CA")
Begin DoDot:1
+38 SET IC=0
+39 FOR
SET IC=$ORDER(^SC(IC))
if +IC=0
QUIT
Begin DoDot:2
+40 SET FACILITY=$PIECE(^SC(IC,0),U,4)
+41 IF $$FACCHECK(FACILITY)
Begin DoDot:3
+42 SET ^TMP(PXRRXTMP,$JOB,"HLOC",FACILITY,IC)=""
End DoDot:3
End DoDot:2
End DoDot:1
+43 ;
+44 ;Build a list of appointments for each location.
+45 SET FAC=""
NFAC SET FAC=$ORDER(^TMP(PXRRXTMP,$JOB,"HLOC",FAC))
+1 IF FAC=""
GOTO APPDONE
+2 ;
+3 SET HLOCIEN=""
NHLOC SET HLOCIEN=$ORDER(^TMP(PXRRXTMP,$JOB,"HLOC",FAC,HLOCIEN))
+1 IF HLOCIEN=""
GOTO NFAC
+2 ;
+3 ;If this is an interactive session let the user know that something
+4 ;is happening.
+5 ;I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting appointments",.BUSY)
+6 ;
+7 ;Check for a user request to stop the task.
+8 IF $$S^%ZTLOAD
SET ZTSTOP=1
DO EXIT^PXRRGUT
+9 ;
+10 SET BD=PXRRBADT-.0001
+11 SET ED=PXRREADT+.2359
NDATE SET BD=$ORDER(^SC(HLOCIEN,"S",BD))
+1 ;If we have passed the ending date we are done.
+2 IF (BD>ED)!(BD="")
GOTO NHLOC
+3 ;
+4 ;If this is an interactive session let the user know that something
+5 ;is happening.
+6 IF '(PXRRQUE!$DATA(IO("S")))
DO SPIN^PXRRBUSY("Sorting appointments",.BUSY)
+7 ;
+8 ;At this point we have an appointment that can be added to the list.
+9 SET IC=0
+10 FOR
SET IC=$ORDER(^SC(HLOCIEN,"S",BD,1,IC))
if +IC=0
QUIT
Begin DoDot:1
+11 SET DFN=$PIECE(^SC(HLOCIEN,"S",BD,1,IC,0),U,1)
+12 SET POV=$PIECE(^DPT(DFN,"S",BD,0),U,7)
+13 SET STATUS=$PIECE(^DPT(DFN,"S",BD,0),U,2)
+14 SET ^XTMP(PXRRXTMP,"APPT",FAC,HLOCIEN,DFN,BD)=STATUS_U_POV
End DoDot:1
+15 ;
+16 ;Get the next appointment.
+17 GOTO NDATE
+18 ;
APPDONE ;
+1 IF '(PXRRQUE!$DATA(IO("S")))
DO DONE^PXRRBUSY("done")
EXIT ;
+1 KILL ^TMP(PXRRXTMP)
+2 ;
+3 ;Build the list of patient activities.
+4 IF PXRRQUE
Begin DoDot:1
+5 ;Start the report that was queued but not scheduled.
+6 NEW DESC,ROUTINE,TASK
+7 SET DESC="Patient Activity Report - patient activities"
+8 SET ROUTINE="PAT^PXRRPAPI"
+9 SET ZTDTH=$$NOW^XLFDT
+10 SET TASK=^XTMP(PXRRXTMP,"PATZTSK")
+11 DO REQUE^PXRRQUE(DESC,ROUTINE,TASK)
End DoDot:1
+12 IF '$TEST
DO PAT^PXRRPAPI
+13 QUIT
+14 ;
+15 ;=======================================================================
FACCHECK(FAC,FACILITY) ;If FAC is on the list of facilities return true.
+1 NEW IC,FOUND
+2 SET FOUND=0
+3 FOR IC=1:1:NFAC
if FOUND
QUIT
Begin DoDot:1
+4 IF $PIECE(PXRRFAC(IC),U,1)=FAC
Begin DoDot:2
+5 SET FOUND=1
End DoDot:2
End DoDot:1
+6 QUIT FOUND
+7 ;
