SDAMA202 ;BPOIFO/ACS-Scheduling Replacement APIs ; 12/13/04 3:15pm
;;5.3;Scheduling;**253,275,283,316,347**;13 Aug 1993
;
;GETPLIST - Returns appointment information for a clinic
;
;** BEFORE USING THE API IN THIS ROUTINE, PLEASE SUBSCRIBE **
;** TO DBIA #3869 **
;
;*******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
;-------- ---------- -----------------------------------------
;09/20/02 SD*5.3*253 ROUTINE COMPLETED
;12/10/02 SD*5.3*275 ADDED PATIENT STATUS FILTER
;07/03/03 SD*5.3*283 REMOVED 'NO ACTION TAKEN' EDIT. REMOVED
; 'GETALLCL' API
;09/16/03 SD*5.3*316 EXCLUDE 'CANCELLED' APPTS. CHECK FOR
; CLINIC MATCH ON ^DPT
;07/26/04 SD*5.3*347 ADDED PATIENT VARIABLE CHECK TO ENSURE THAT
; VALUE RETURNED FROM $$GETPTIEN^SDAMA200 IS
; NOT NULL
; REMOVE DIRECT ACCESS TO DATA. ALL ACCESS
; THROUGH SDAPI ONLY
;********************************************************************
;
GETPLIST(SDCLIEN,SDFIELDS,SDAPSTAT,SDSTART,SDEND,SDRESULT,SDIOSTAT) ;
;********************************************************************
;
; GET APPOINTMENTS FOR A CLINIC
;
;INPUT
; SDCLIEN Clinic IEN (required)
; SDFIELDS Fields requested (optional)
; SDAPSTAT Appointment Status filter (optional)
; SDSTART Start date/time (optional)
; SDEND End date/time (optional)
; SDRESULT Record count returned here (optional)
; SDIOSTAT Patient Status filter (optional)
;
;OUTPUT
; ^TMP($J,"SDAMA202","GETPLIST",X,Y)=FieldYdata
; where "X" is an incremental appointment counter and
; "Y" is the field number requested
;
;
;********************************************************************
N SDAPINAM,SDRTNNAM
S SDAPINAM="GETPLIST",SDRTNNAM="SDAMA202",SDRESULT=0
K ^TMP($J,SDRTNNAM,SDAPINAM)
S SDRESULT=$$VALIDATE^SDAMA200(.SDCLIEN,.SDFIELDS,.SDAPSTAT,.SDSTART,.SDEND,SDAPINAM,SDRTNNAM,.SDIOSTAT)
I SDRESULT=-1 Q
;
N SDCOUNT,SDNUM,SDTMP,SDI,SDARRAY,SDAPLST,SDX,SDY,SDCI,SDPI,SDTI,SDTR,SDF,SDA,SDR,SDO
S (SDNUM,SDCOUNT,SDI)=0,(SDAPLST,SDTMP)=""
F SDI="SDFIELDS","SDAPSTAT","SDSTART","SDEND","SDRESULT","SDIOSTAT" S @SDI=$G(@SDI)
; Quit if only status requested is "C"
I SDAPSTAT="C"!(SDAPSTAT=";C;") S SDRESULT=0 Q
I +SDSTART!(+SDEND) S SDARRAY(1)=SDSTART_";"_SDEND
S SDARRAY(2)=SDCLIEN
I $L($G(SDAPSTAT))>0 D
. ;Remove a leading and a trailing semicolon
. I $E(SDAPSTAT,$L(SDAPSTAT))=";" S SDAPSTAT=$E(SDAPSTAT,1,($L(SDAPSTAT)-1))
. I $E(SDAPSTAT)=";" S SDAPSTAT=$E(SDAPSTAT,2,$L(SDAPSTAT))
. ;IO/Appt Statuses have been validated by SDAMA200 to be I or O/R NT
. I $L($G(SDIOSTAT))=1 S SDAPLST=$S(SDIOSTAT="I":"I;",SDIOSTAT="O":SDAPSTAT_";")
. I $L($G(SDIOSTAT))'=1,$L($G(SDAPSTAT)) D
.. ;Reset appointment status R=R;I N=NS,NSR
.. S SDNUM=$L(SDAPSTAT,";") F SDI=1:1:SDNUM D
... S SDTMP=$P(SDAPSTAT,";",SDI) Q:SDTMP="C"
... S SDTMP=$S(SDTMP="R":"R;I",SDTMP="N":"NS;NSR",1:SDTMP)
... S SDAPLST=SDAPLST_SDTMP_";"
. ;Remove trailing semicolon
. S SDAPLST=$E(SDAPLST,1,($L(SDAPLST)-1))
I $L($G(SDAPSTAT))=0 S SDAPLST="R;I;NS;NSR;NT"
S SDARRAY(3)=SDAPLST
;Field List Conversion
S SDARRAY("FLDS")=""
F SDX=1:1 S SDY=$P(SDFIELDS,";",SDX) Q:SDY="" D
. I SDY=12,SDFIELDS[3 Q ; if appt. stat. exists, pat. stat. not needed
. I SDY=12 S SDY=3
. S SDARRAY("FLDS")=SDARRAY("FLDS")_SDY_";"
S:$L(SDARRAY("FLDS")) SDARRAY("FLDS")=$E(SDARRAY("FLDS"),1,$L(SDARRAY("FLDS"))-1)
I '$L(SDFIELDS) S SDARRAY("FLDS")="1;2;3;4;5;6;7;8;9;10;11"
;
; Setup done, call SDAPI, quit if no appointment (SDCOUNT=0) and return 0
SDAPI S (SDRESULT,SDCOUNT)=$$SDAPI^SDAMA301(.SDARRAY) I SDCOUNT=0 S SDRESULT=0 Q
;
;If we have an appointment, process it
I SDCOUNT>0 S SDA=0,SDCI="" F S SDCI=$O(^TMP($J,"SDAMA301",SDCI)) Q:SDCI="" D
. S SDPI="" F S SDPI=$O(^TMP($J,"SDAMA301",SDCI,SDPI)) Q:SDPI="" D
.. S SDTI="" F S SDTI=$O(^TMP($J,"SDAMA301",SDCI,SDPI,SDTI)) Q:SDTI="" S SDTR=^(SDTI) D
... S SDA=SDA+1 F SDX=1:1 S SDF=$P(SDFIELDS,";",SDX),SDY=$P(SDTR,"^",SDF) Q:SDF="" D
.... I "^1^5^9^11^"[(U_SDF_U) S SDO=SDY D OUT Q
.... I "^2^4^8^10^"[(U_SDF_U) S SDO=$TR(SDY,";","^") D OUT Q
.... I "^3^6^7^12^"[(U_SDF_U) D @("FLD"_SDF)
; Process errors if any
I SDCOUNT<0 D
.S SDRESULT=-1,SDX=$O(^TMP($J,"SDAMA301",""))
.S SDX=$S(SDX=101:101,SDX=116:116,1:117)
.D ERROR^SDAMA200(SDX,SDAPINAM,0,SDRTNNAM) Q
K ^TMP($J,"SDAMA301")
Q
FLD3 S SDR=$P(SDY,";",1)
S SDO=$S(SDR="I":"R",SDR?1(1"NS",1"NSR"):"N",1:SDR) D OUT
Q
FLD6 S SDO=$G(^TMP($J,"SDAMA301",SDCI,SDPI,SDTI,"C"))
D OUT
Q
FLD7 S SDO=$S(SDY="":"N",1:SDY)
D OUT
Q
FLD12 S SDR=$P($P(SDTR,U,3),";",1)
S SDO=$S(SDR="I":"I",SDR="R":"O",SDR="NT":"O",1:"") D OUT
Q
OUT S ^TMP($J,"SDAMA202","GETPLIST",SDA,SDF)=SDO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMA202 5101 printed Dec 13, 2024@02:47:11 Page 2
SDAMA202 ;BPOIFO/ACS-Scheduling Replacement APIs ; 12/13/04 3:15pm
+1 ;;5.3;Scheduling;**253,275,283,316,347**;13 Aug 1993
+2 ;
+3 ;GETPLIST - Returns appointment information for a clinic
+4 ;
+5 ;** BEFORE USING THE API IN THIS ROUTINE, PLEASE SUBSCRIBE **
+6 ;** TO DBIA #3869 **
+7 ;
+8 ;*******************************************************************
+9 ; CHANGE LOG
+10 ;
+11 ; DATE PATCH DESCRIPTION
+12 ;-------- ---------- -----------------------------------------
+13 ;09/20/02 SD*5.3*253 ROUTINE COMPLETED
+14 ;12/10/02 SD*5.3*275 ADDED PATIENT STATUS FILTER
+15 ;07/03/03 SD*5.3*283 REMOVED 'NO ACTION TAKEN' EDIT. REMOVED
+16 ; 'GETALLCL' API
+17 ;09/16/03 SD*5.3*316 EXCLUDE 'CANCELLED' APPTS. CHECK FOR
+18 ; CLINIC MATCH ON ^DPT
+19 ;07/26/04 SD*5.3*347 ADDED PATIENT VARIABLE CHECK TO ENSURE THAT
+20 ; VALUE RETURNED FROM $$GETPTIEN^SDAMA200 IS
+21 ; NOT NULL
+22 ; REMOVE DIRECT ACCESS TO DATA. ALL ACCESS
+23 ; THROUGH SDAPI ONLY
+24 ;********************************************************************
+25 ;
GETPLIST(SDCLIEN,SDFIELDS,SDAPSTAT,SDSTART,SDEND,SDRESULT,SDIOSTAT) ;
+1 ;********************************************************************
+2 ;
+3 ; GET APPOINTMENTS FOR A CLINIC
+4 ;
+5 ;INPUT
+6 ; SDCLIEN Clinic IEN (required)
+7 ; SDFIELDS Fields requested (optional)
+8 ; SDAPSTAT Appointment Status filter (optional)
+9 ; SDSTART Start date/time (optional)
+10 ; SDEND End date/time (optional)
+11 ; SDRESULT Record count returned here (optional)
+12 ; SDIOSTAT Patient Status filter (optional)
+13 ;
+14 ;OUTPUT
+15 ; ^TMP($J,"SDAMA202","GETPLIST",X,Y)=FieldYdata
+16 ; where "X" is an incremental appointment counter and
+17 ; "Y" is the field number requested
+18 ;
+19 ;
+20 ;********************************************************************
+21 NEW SDAPINAM,SDRTNNAM
+22 SET SDAPINAM="GETPLIST"
SET SDRTNNAM="SDAMA202"
SET SDRESULT=0
+23 KILL ^TMP($JOB,SDRTNNAM,SDAPINAM)
+24 SET SDRESULT=$$VALIDATE^SDAMA200(.SDCLIEN,.SDFIELDS,.SDAPSTAT,.SDSTART,.SDEND,SDAPINAM,SDRTNNAM,.SDIOSTAT)
+25 IF SDRESULT=-1
QUIT
+26 ;
+27 NEW SDCOUNT,SDNUM,SDTMP,SDI,SDARRAY,SDAPLST,SDX,SDY,SDCI,SDPI,SDTI,SDTR,SDF,SDA,SDR,SDO
+28 SET (SDNUM,SDCOUNT,SDI)=0
SET (SDAPLST,SDTMP)=""
+29 FOR SDI="SDFIELDS","SDAPSTAT","SDSTART","SDEND","SDRESULT","SDIOSTAT"
SET @SDI=$GET(@SDI)
+30 ; Quit if only status requested is "C"
+31 IF SDAPSTAT="C"!(SDAPSTAT=";C;")
SET SDRESULT=0
QUIT
+32 IF +SDSTART!(+SDEND)
SET SDARRAY(1)=SDSTART_";"_SDEND
+33 SET SDARRAY(2)=SDCLIEN
+34 IF $LENGTH($GET(SDAPSTAT))>0
Begin DoDot:1
+35 ;Remove a leading and a trailing semicolon
+36 IF $EXTRACT(SDAPSTAT,$LENGTH(SDAPSTAT))=";"
SET SDAPSTAT=$EXTRACT(SDAPSTAT,1,($LENGTH(SDAPSTAT)-1))
+37 IF $EXTRACT(SDAPSTAT)=";"
SET SDAPSTAT=$EXTRACT(SDAPSTAT,2,$LENGTH(SDAPSTAT))
+38 ;IO/Appt Statuses have been validated by SDAMA200 to be I or O/R NT
+39 IF $LENGTH($GET(SDIOSTAT))=1
SET SDAPLST=$SELECT(SDIOSTAT="I":"I;",SDIOSTAT="O":SDAPSTAT_";")
+40 IF $LENGTH($GET(SDIOSTAT))'=1
IF $LENGTH($GET(SDAPSTAT))
Begin DoDot:2
+41 ;Reset appointment status R=R;I N=NS,NSR
+42 SET SDNUM=$LENGTH(SDAPSTAT,";")
FOR SDI=1:1:SDNUM
Begin DoDot:3
+43 SET SDTMP=$PIECE(SDAPSTAT,";",SDI)
if SDTMP="C"
QUIT
+44 SET SDTMP=$SELECT(SDTMP="R":"R;I",SDTMP="N":"NS;NSR",1:SDTMP)
+45 SET SDAPLST=SDAPLST_SDTMP_";"
End DoDot:3
End DoDot:2
+46 ;Remove trailing semicolon
+47 SET SDAPLST=$EXTRACT(SDAPLST,1,($LENGTH(SDAPLST)-1))
End DoDot:1
+48 IF $LENGTH($GET(SDAPSTAT))=0
SET SDAPLST="R;I;NS;NSR;NT"
+49 SET SDARRAY(3)=SDAPLST
+50 ;Field List Conversion
+51 SET SDARRAY("FLDS")=""
+52 FOR SDX=1:1
SET SDY=$PIECE(SDFIELDS,";",SDX)
if SDY=""
QUIT
Begin DoDot:1
+53 ; if appt. stat. exists, pat. stat. not needed
IF SDY=12
IF SDFIELDS[3
QUIT
+54 IF SDY=12
SET SDY=3
+55 SET SDARRAY("FLDS")=SDARRAY("FLDS")_SDY_";"
End DoDot:1
+56 if $LENGTH(SDARRAY("FLDS"))
SET SDARRAY("FLDS")=$EXTRACT(SDARRAY("FLDS"),1,$LENGTH(SDARRAY("FLDS"))-1)
+57 IF '$LENGTH(SDFIELDS)
SET SDARRAY("FLDS")="1;2;3;4;5;6;7;8;9;10;11"
+58 ;
+59 ; Setup done, call SDAPI, quit if no appointment (SDCOUNT=0) and return 0
SDAPI SET (SDRESULT,SDCOUNT)=$$SDAPI^SDAMA301(.SDARRAY)
IF SDCOUNT=0
SET SDRESULT=0
QUIT
+1 ;
+2 ;If we have an appointment, process it
+3 IF SDCOUNT>0
SET SDA=0
SET SDCI=""
FOR
SET SDCI=$ORDER(^TMP($JOB,"SDAMA301",SDCI))
if SDCI=""
QUIT
Begin DoDot:1
+4 SET SDPI=""
FOR
SET SDPI=$ORDER(^TMP($JOB,"SDAMA301",SDCI,SDPI))
if SDPI=""
QUIT
Begin DoDot:2
+5 SET SDTI=""
FOR
SET SDTI=$ORDER(^TMP($JOB,"SDAMA301",SDCI,SDPI,SDTI))
if SDTI=""
QUIT
SET SDTR=^(SDTI)
Begin DoDot:3
+6 SET SDA=SDA+1
FOR SDX=1:1
SET SDF=$PIECE(SDFIELDS,";",SDX)
SET SDY=$PIECE(SDTR,"^",SDF)
if SDF=""
QUIT
Begin DoDot:4
+7 IF "^1^5^9^11^"[(U_SDF_U)
SET SDO=SDY
DO OUT
QUIT
+8 IF "^2^4^8^10^"[(U_SDF_U)
SET SDO=$TRANSLATE(SDY,";","^")
DO OUT
QUIT
+9 IF "^3^6^7^12^"[(U_SDF_U)
DO @("FLD"_SDF)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+10 ; Process errors if any
+11 IF SDCOUNT<0
Begin DoDot:1
+12 SET SDRESULT=-1
SET SDX=$ORDER(^TMP($JOB,"SDAMA301",""))
+13 SET SDX=$SELECT(SDX=101:101,SDX=116:116,1:117)
+14 DO ERROR^SDAMA200(SDX,SDAPINAM,0,SDRTNNAM)
QUIT
End DoDot:1
+15 KILL ^TMP($JOB,"SDAMA301")
+16 QUIT
FLD3 SET SDR=$PIECE(SDY,";",1)
+1 SET SDO=$SELECT(SDR="I":"R",SDR?1(1"NS",1"NSR"):"N",1:SDR)
DO OUT
+2 QUIT
FLD6 SET SDO=$GET(^TMP($JOB,"SDAMA301",SDCI,SDPI,SDTI,"C"))
+1 DO OUT
+2 QUIT
FLD7 SET SDO=$SELECT(SDY="":"N",1:SDY)
+1 DO OUT
+2 QUIT
FLD12 SET SDR=$PIECE($PIECE(SDTR,U,3),";",1)
+1 SET SDO=$SELECT(SDR="I":"I",SDR="R":"O",SDR="NT":"O",1:"")
DO OUT
+2 QUIT
OUT SET ^TMP($JOB,"SDAMA202","GETPLIST",SDA,SDF)=SDO
+1 QUIT
