- 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 Jan 18, 2025@03:48:20 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