SDAMA305 ;BPOIFO/ACS-Filter API Get Data ; 6/21/05 1:50pm
;;5.3;Scheduling;**301,347,508**;13 Aug 1993
;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
;
;*****************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
;-------- ---------- -----------------------------------------
;12/04/03 SD*5.3*301 ROUTINE COMPLETED
;08/06/04 SD*5.3*347 ADDITION OF A NEW FILTER - DATE APPOINTMENT
; MADE (FIELD #16) AND 2 NEW FIELDS TO RETURN:
; 1) AUTO-REBOOKED APPT DATE/TIME (FIELD #24)
; 2) NO-SHOW/CANCEL APPT DATE/TIME (FIELD #25)
; RENAME ENTRY POINT TO ROUTINE
;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
;*****************************************************************
;
;*****************************************************************
; GET APPOINTMENT DATA FROM VISTA
;INPUT
; SDARRAY Appointment Filter array
;
;OUTPUT
; ^TMP($J,"SDAMA301",SORT1,SORT2,APPT D/T)
;*****************************************************************
SETARRAY(SDARRAY) ;
;Initialize local variables
N SDI,SDIEN,SDNAME,SDFLDS,SDDATA,SDCOUNT,SDFIELD,SDCLIEN,SDDV,SDSCRTCH
S SDFLDS=SDARRAY("FLDS")
S SDCOUNT=$L(SDFLDS,";")
;Add 1 to appointment count
S SDARRAY("CNT")=(SDARRAY("CNT")+1)
;For each appoitment field requested
F SDI=1:1:SDCOUNT D
. S (SDIEN,SDNAME,SDDATA)=""
. S SDFIELD=$P(SDFLDS,";",SDI)
. ;get data
. D @SDFIELD
. ;nodes in output global can't be null
. I $G(SDARRAY("SORT1"))="" S SDARRAY("SORT1")="X"_SDARRAY("CNT")
. I $G(SDARRAY("SORT2"))="" S SDARRAY("SORT2")="Y"_SDARRAY("CNT")
. ;add data to output array
. ;Store information with just Patient IEN (No Clinic IEN) in the global reference
. I $G(SDARRAY("SORT"))="P" D
. .S:(SDFIELD<28) $P(^TMP($J,"SDAMA301",$G(SDARRAY("PAT")),SDARRAY("DATE")),"^",SDFIELD)=$S(SDFIELD=6:"",1:$G(SDDV(SDFIELD)))
. .S:(SDFIELD>27) $P(^TMP($J,"SDAMA301",$G(SDARRAY("PAT")),SDARRAY("DATE"),0),"^",(SDFIELD#27))=$G(SDDV(SDFIELD))
. .S:(SDFIELD=6) ^TMP($J,"SDAMA301",$G(SDARRAY("PAT")),SDARRAY("DATE"),"C")=$G(SDDV(SDFIELD))
. ;Store information with Patient and Clinic IEN (Sort1, Sort2) in the global reference
. I $G(SDARRAY("SORT"))'="P" D
. .S:(SDFIELD<28) $P(^TMP($J,"SDAMA301",SDARRAY("SORT1"),SDARRAY("SORT2"),SDARRAY("DATE")),"^",SDFIELD)=$S(SDFIELD=6:"",1:$G(SDDV(SDFIELD)))
. .S:(SDFIELD>27) $P(^TMP($J,"SDAMA301",SDARRAY("SORT1"),SDARRAY("SORT2"),SDARRAY("DATE"),0),"^",(SDFIELD#27))=$G(SDDV(SDFIELD))
. .S:(SDFIELD=6) ^TMP($J,"SDAMA301",SDARRAY("SORT1"),SDARRAY("SORT2"),SDARRAY("DATE"),"C")=$G(SDDV(SDFIELD))
Q
1 ;Appt date/time
S SDDV(SDFIELD)=SDARRAY("DATE")
Q
2 ;Clinic IEN and Name
S SDIEN=+$G(SDARRAY("DPT0"))
I '$G(SDIEN) S SDNAME=""
E S SDNAME=$P($G(^SC(SDIEN,0)),"^",1)
S SDDV(SDFIELD)=$G(SDIEN)_";"_$G(SDNAME)
Q
3 ;Appt Status and Status Description
N SDSTAT
S SDSTAT=$P($G(SDARRAY("DPT0")),"^",2)
I $G(SDSTAT)="" S SDDATA="R;SCHEDULED/KEPT"
E D
. S SDDATA=$S(SDSTAT="I":"I;INPATIENT",SDSTAT="C":"CC;CANCELLED BY CLINIC",1:"X")
. I SDDATA="X" S SDDATA=$S(SDSTAT="CA":"CCR;CANCELLED BY CLINIC & RESCHEDULED",SDSTAT="PC":"CP;CANCELLED BY PATIENT",1:"X")
. I SDDATA="X" S SDDATA=$S(SDSTAT="PCA":"CPR;CANCELLED BY PATIENT & RESCHEDULED",SDSTAT="N":"NS;NO-SHOW",1:"X")
. I SDDATA="X" S SDDATA=$S(SDSTAT="NA":"NSR;NO-SHOW & RESCHEDULED",SDSTAT="NT":"NT;NO ACTION TAKEN",1:SDSTAT_";UNKNOWN")
S SDDV(SDFIELD)=SDDATA
Q
4 ;Patient IEN and Name
S SDIEN=$G(SDARRAY("PAT"))
S SDNAME=$P($G(^DPT(SDIEN,0)),"^",1)
S SDDV(SDFIELD)=$G(SDIEN)_";"_$G(SDNAME)
Q
5 ;Length of Appt
S SDDV(SDFIELD)=$P($G(SDARRAY("SC0")),"^",2)
Q
6 ;Comments
S SDDV(SDFIELD)=$P($G(SDARRAY("SC0")),"^",4)
Q
7 ;Overbook (return null if appt cancelled)
I $G(SDARRAY("SC0"))'="" D
. S SDDATA=$P($G(SDARRAY("SCOB")),"^",1)
. S SDDV(SDFIELD)=$S($G(SDDATA)="O":"Y",1:"N")
Q
8 ;Local & National Eligiblity of Visit Codes and Names
N SDELIG,SDPELIG,SDASTS,DFN,VAROOT,VAERR
S VAERR=0,SDDATA=$P($G(SDARRAY("SC0")),"^",10)
S SDASTS=$P($G(SDARRAY("DPT0")),"^",2)
;if eligibility is null, get patients primary eligibility
; * only if appointment status is not cancelled *
I (($G(SDDATA)']"")&($G(SDASTS)'["C")) D
. S VAROOT="SDPELIG",DFN=$G(SDARRAY("PAT")) D ELIG^VADPT
. S SDDATA=$P(SDPELIG(1),"^")
;get local/national eligibility to add to output if
;ELIG^VADPT did not error and the ien is not null
I (('VAERR)&($G(SDDATA)]"")) D
. S SDELIG=$G(^DIC(8,SDDATA,0))
. ;Append Local Eligibility IEN and Name
. S SDDV(SDFIELD)=$G(SDDATA)_";"_$P(SDELIG,"^")
. ;Append National Eligibility IEN and Name
. S SDIEN=$P(SDELIG,"^",9)
. I $G(SDIEN) D
.. S SDNAME=$P($G(^DIC(8.1,SDIEN,0)),"^",1)
.. S SDDV(SDFIELD)=SDDV(SDFIELD)_";"_$G(SDIEN)_";"_$G(SDNAME)
Q
9 ;Check-In Date/time
S SDSCRTCH=$P($G(SDARRAY("SCC")),"^",1)
S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
Q
10 ;Appt Type IEN and Name
S SDIEN=$P($G(SDARRAY("DPT0")),"^",16)
I $G(SDIEN)]"" D
. S SDNAME=$P($G(^SD(409.1,SDIEN,0)),"^",1)
. S SDDV(SDFIELD)=$G(SDIEN)_";"_$G(SDNAME)
Q
11 ;Check-Out date/time
S SDSCRTCH=$P($G(SDARRAY("SCC")),"^",3)
S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
Q
12 ;Outpatient Encounter
S SDDV(SDFIELD)=$P($G(SDARRAY("DPT0")),"^",20)
Q
13 ;Primary Stop Code IEN and AMIS STOP CODE
N SDCODES
S SDCLIEN=+SDARRAY("DPT0")
I $G(SDCLIEN)]"" D
. S SDCODES=$$GETSTOP(SDCLIEN)
. I SDCODES'=-1 S SDDV(SDFIELD)=$P(SDCODES,"^",1)
Q
14 ;Credit Stop Code IEN and AMIS STOP CODE
S SDCLIEN=+SDARRAY("DPT0")
I $G(SDCLIEN)]"" D
. S SDCODES=$$GETSTOP(SDCLIEN)
. I SDCODES'=-1 S SDDV(SDFIELD)=$P(SDCODES,"^",2)
Q
15 ;Workload Non-Count
S SDCLIEN=+SDARRAY("DPT0")
I $G(SDCLIEN)]"" D
. S SDCODES=$$GETSTOP(SDCLIEN)
. I SDCODES'=-1 S SDDV(SDFIELD)=$P($G(SDCODES),"^",3)
Q
16 ;Date Appt Made
S SDDV(SDFIELD)=$P($P($G(SDARRAY("DPT0")),"^",19),".")
Q
17 ;Desired Date of Appt
S SDDV(SDFIELD)=$P($P($G(SDARRAY("DPT1")),"^",1),".")
Q
18 ;Purpose of Visit
S SDDATA=$P($G(SDARRAY("DPT0")),"^",7)
I $G(SDDATA)'="" D
. S SDDATA=SDDATA_$S(SDDATA="1":";C&P",SDDATA="2":";10-10",SDDATA="3":";SV",SDDATA="4":";UV",1:";")
. S SDDV(SDFIELD)=SDDATA
Q
19 ;EKG Date/time
S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",5)
S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
Q
20 ;X-Ray Date/time
S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",4)
S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
Q
21 ;Lab Date/time
S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",3)
S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
Q
22 ;Status
; (Status IEN; Status Description; Print Status; Checked In Date/Time;
; Checked Out Date/Time; Admission Movement IEN)
;convert to new appt status code
D 3
S SDDV(SDFIELD)=$$STATUS^SDAMA308(+$G(SDARRAY("PAT")),+$G(SDARRAY("DATE")),+$G(SDARRAY("DPT0")),$P(SDDV(SDFIELD),";"),$P($G(SDARRAY("SCC")),"^"),$P($G(SDARRAY("SCC")),"^",3),$P($G(SDARRAY("DPT0")),"^",20))
Q
23 ;X-Ray Films
N SDRECS
;Get Clinic IEN, X-Ray Films Required
S SDIEN=+$G(SDARRAY("DPT0"))
S SDRECS=$P($G(^SC(SDIEN,"RAD")),"^")
;Translate Lower Case to Upper
S SDRECS=$TR(SDRECS,"ny","NY")
S SDDATA=$S(SDRECS["Y":"Y",1:"N")
S SDDV(SDFIELD)=SDDATA
Q
24 ;Auto-Rebooked Appt. Date/Time
S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",10)
S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
Q
25 ;No-Show/Cancel Date/Time
S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",14)
S SDDV(SDFIELD)=$S($L(SDSCRTCH)<13:SDSCRTCH,1:$E(SDSCRTCH,1,12))
Q
;This field is only associated with appt info from RSA
;(No VistA Scheduling Value Exists)
26 ;RSA Appointment ID
Q
27 ;2507 Request IEN
;N SDREQ
;retrieve 2507 request for patient's appt
;S SDREQ=$$GET2507^DVBCMKLK(+$G(SDARRAY("PAT")),$G(SDARRAY("DATE")))
;S SDDV(SDFIELD)=$S((SDREQ>0):SDREQ,1:"")
Q
28 ;Data Entry Clerk DUZ and Name
N SDSTAT
S SDSTAT=$P($G(SDARRAY("DPT0")),"^",2) ;determine appt status
;Appt is deleted from ^SC when appt is cancelled
S SDSCRTCH=$S(SDSTAT["C":$P($G(SDARRAY("DPT0")),"^",18),1:$P($G(SDARRAY("SC0")),"^",6))
S:(+SDSCRTCH) SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
Q
29 ;No-Show/Cancelled By DUZ and Name
S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",12)
S:(+SDSCRTCH) SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
Q
30 ;Check-In User DUZ and Name
S SDSCRTCH=$P($G(SDARRAY("SCC")),"^",2)
S:(+SDSCRTCH) SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
Q
31 ;Check-Out User DUZ and Name
S SDSCRTCH=$P($G(SDARRAY("SCC")),"^",4)
S:(+SDSCRTCH) SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
Q
32 ;Cancellation Reason IEN and Name
S SDSCRTCH=$P($G(SDARRAY("DPT0")),"^",15)
S:(+SDSCRTCH) SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(409.2,SDSCRTCH,.01)
Q
33 ;Consult Link IEN
S SDDV(SDFIELD)=$G(SDARRAY("SCONS"))
Q
GETSTOP(SDCLIEN) ;Primary Stop Code, Credit Stop Code, Non-Count
; return codes or -1 if bad clinic
N SDPSC,SDPSCIEN,SDCSC,SDCSCIEN,SDNC,SDCODES
I +$G(SDCLIEN)=0 S SDCODES=-1
I +$G(SDCLIEN)'=0 D
. ;make sure clinic is on ^SC
. I '$D(^SC(SDCLIEN)) S SDCODES=-1 Q
. ;get primary stop code ien
. S SDPSCIEN=$P($G(^SC(SDCLIEN,0)),"^",7)
. ;get credit stop code ien
. S SDCSCIEN=$P($G(^SC(SDCLIEN,0)),"^",18)
. I $G(SDPSCIEN) S SDPSC=$P($G(^DIC(40.7,SDPSCIEN,0)),"^",2)
. I $G(SDCSCIEN) S SDCSC=$P($G(^DIC(40.7,SDCSCIEN,0)),"^",2)
. ;get workload non-count
. S SDNC=$P($G(^SC(SDCLIEN,0)),"^",17)
. S SDNC=$S($G(SDNC)="Y":"Y",1:"N")
. S SDCODES=$G(SDPSCIEN)_";"_$G(SDPSC)_"^"_$G(SDCSCIEN)_";"_$G(SDCSC)_"^"_SDNC
Q SDCODES
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMA305 9907 printed Apr 09, 2024@22:01:30 Page 2
SDAMA305 ;BPOIFO/ACS-Filter API Get Data ; 6/21/05 1:50pm
+1 ;;5.3;Scheduling;**301,347,508**;13 Aug 1993
+2 ;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
+3 ;
+4 ;*****************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ;-------- ---------- -----------------------------------------
+9 ;12/04/03 SD*5.3*301 ROUTINE COMPLETED
+10 ;08/06/04 SD*5.3*347 ADDITION OF A NEW FILTER - DATE APPOINTMENT
+11 ; MADE (FIELD #16) AND 2 NEW FIELDS TO RETURN:
+12 ; 1) AUTO-REBOOKED APPT DATE/TIME (FIELD #24)
+13 ; 2) NO-SHOW/CANCEL APPT DATE/TIME (FIELD #25)
+14 ; RENAME ENTRY POINT TO ROUTINE
+15 ;02/22/07 SD*5.3*508 SEE SDAMA301 FOR CHANGE LIST
+16 ;*****************************************************************
+17 ;
+18 ;*****************************************************************
+19 ; GET APPOINTMENT DATA FROM VISTA
+20 ;INPUT
+21 ; SDARRAY Appointment Filter array
+22 ;
+23 ;OUTPUT
+24 ; ^TMP($J,"SDAMA301",SORT1,SORT2,APPT D/T)
+25 ;*****************************************************************
SETARRAY(SDARRAY) ;
+1 ;Initialize local variables
+2 NEW SDI,SDIEN,SDNAME,SDFLDS,SDDATA,SDCOUNT,SDFIELD,SDCLIEN,SDDV,SDSCRTCH
+3 SET SDFLDS=SDARRAY("FLDS")
+4 SET SDCOUNT=$LENGTH(SDFLDS,";")
+5 ;Add 1 to appointment count
+6 SET SDARRAY("CNT")=(SDARRAY("CNT")+1)
+7 ;For each appoitment field requested
+8 FOR SDI=1:1:SDCOUNT
Begin DoDot:1
+9 SET (SDIEN,SDNAME,SDDATA)=""
+10 SET SDFIELD=$PIECE(SDFLDS,";",SDI)
+11 ;get data
+12 DO @SDFIELD
+13 ;nodes in output global can't be null
+14 IF $GET(SDARRAY("SORT1"))=""
SET SDARRAY("SORT1")="X"_SDARRAY("CNT")
+15 IF $GET(SDARRAY("SORT2"))=""
SET SDARRAY("SORT2")="Y"_SDARRAY("CNT")
+16 ;add data to output array
+17 ;Store information with just Patient IEN (No Clinic IEN) in the global reference
+18 IF $GET(SDARRAY("SORT"))="P"
Begin DoDot:2
+19 if (SDFIELD<28)
SET $PIECE(^TMP($JOB,"SDAMA301",$GET(SDARRAY("PAT")),SDARRAY("DATE")),"^",SDFIELD)=$SELECT(SDFIELD=6:"",1:$GET(SDDV(SDFIELD)))
+20 if (SDFIELD>27)
SET $PIECE(^TMP($JOB,"SDAMA301",$GET(SDARRAY("PAT")),SDARRAY("DATE"),0),"^",(SDFIELD#27))=$GET(SDDV(SDFIELD))
+21 if (SDFIELD=6)
SET ^TMP($JOB,"SDAMA301",$GET(SDARRAY("PAT")),SDARRAY("DATE"),"C")=$GET(SDDV(SDFIELD))
End DoDot:2
+22 ;Store information with Patient and Clinic IEN (Sort1, Sort2) in the global reference
+23 IF $GET(SDARRAY("SORT"))'="P"
Begin DoDot:2
+24 if (SDFIELD<28)
SET $PIECE(^TMP($JOB,"SDAMA301",SDARRAY("SORT1"),SDARRAY("SORT2"),SDARRAY("DATE")),"^",SDFIELD)=$SELECT(SDFIELD=6:"",1:$GET(SDDV(SDFIELD)))
+25 if (SDFIELD>27)
SET $PIECE(^TMP($JOB,"SDAMA301",SDARRAY("SORT1"),SDARRAY("SORT2"),SDARRAY("DATE"),0),"^",(SDFIELD#27))=$GET(SDDV(SDFIELD))
+26 if (SDFIELD=6)
SET ^TMP($JOB,"SDAMA301",SDARRAY("SORT1"),SDARRAY("SORT2"),SDARRAY("DATE"),"C")=$GET(SDDV(SDFIELD))
End DoDot:2
End DoDot:1
+27 QUIT
1 ;Appt date/time
+1 SET SDDV(SDFIELD)=SDARRAY("DATE")
+2 QUIT
2 ;Clinic IEN and Name
+1 SET SDIEN=+$GET(SDARRAY("DPT0"))
+2 IF '$GET(SDIEN)
SET SDNAME=""
+3 IF '$TEST
SET SDNAME=$PIECE($GET(^SC(SDIEN,0)),"^",1)
+4 SET SDDV(SDFIELD)=$GET(SDIEN)_";"_$GET(SDNAME)
+5 QUIT
3 ;Appt Status and Status Description
+1 NEW SDSTAT
+2 SET SDSTAT=$PIECE($GET(SDARRAY("DPT0")),"^",2)
+3 IF $GET(SDSTAT)=""
SET SDDATA="R;SCHEDULED/KEPT"
+4 IF '$TEST
Begin DoDot:1
+5 SET SDDATA=$SELECT(SDSTAT="I":"I;INPATIENT",SDSTAT="C":"CC;CANCELLED BY CLINIC",1:"X")
+6 IF SDDATA="X"
SET SDDATA=$SELECT(SDSTAT="CA":"CCR;CANCELLED BY CLINIC & RESCHEDULED",SDSTAT="PC":"CP;CANCELLED BY PATIENT",1:"X")
+7 IF SDDATA="X"
SET SDDATA=$SELECT(SDSTAT="PCA":"CPR;CANCELLED BY PATIENT & RESCHEDULED",SDSTAT="N":"NS;NO-SHOW",1:"X")
+8 IF SDDATA="X"
SET SDDATA=$SELECT(SDSTAT="NA":"NSR;NO-SHOW & RESCHEDULED",SDSTAT="NT":"NT;NO ACTION TAKEN",1:SDSTAT_";UNKNOWN")
End DoDot:1
+9 SET SDDV(SDFIELD)=SDDATA
+10 QUIT
4 ;Patient IEN and Name
+1 SET SDIEN=$GET(SDARRAY("PAT"))
+2 SET SDNAME=$PIECE($GET(^DPT(SDIEN,0)),"^",1)
+3 SET SDDV(SDFIELD)=$GET(SDIEN)_";"_$GET(SDNAME)
+4 QUIT
5 ;Length of Appt
+1 SET SDDV(SDFIELD)=$PIECE($GET(SDARRAY("SC0")),"^",2)
+2 QUIT
6 ;Comments
+1 SET SDDV(SDFIELD)=$PIECE($GET(SDARRAY("SC0")),"^",4)
+2 QUIT
7 ;Overbook (return null if appt cancelled)
+1 IF $GET(SDARRAY("SC0"))'=""
Begin DoDot:1
+2 SET SDDATA=$PIECE($GET(SDARRAY("SCOB")),"^",1)
+3 SET SDDV(SDFIELD)=$SELECT($GET(SDDATA)="O":"Y",1:"N")
End DoDot:1
+4 QUIT
8 ;Local & National Eligiblity of Visit Codes and Names
+1 NEW SDELIG,SDPELIG,SDASTS,DFN,VAROOT,VAERR
+2 SET VAERR=0
SET SDDATA=$PIECE($GET(SDARRAY("SC0")),"^",10)
+3 SET SDASTS=$PIECE($GET(SDARRAY("DPT0")),"^",2)
+4 ;if eligibility is null, get patients primary eligibility
+5 ; * only if appointment status is not cancelled *
+6 IF (($GET(SDDATA)']"")&($GET(SDASTS)'["C"))
Begin DoDot:1
+7 SET VAROOT="SDPELIG"
SET DFN=$GET(SDARRAY("PAT"))
DO ELIG^VADPT
+8 SET SDDATA=$PIECE(SDPELIG(1),"^")
End DoDot:1
+9 ;get local/national eligibility to add to output if
+10 ;ELIG^VADPT did not error and the ien is not null
+11 IF (('VAERR)&($GET(SDDATA)]""))
Begin DoDot:1
+12 SET SDELIG=$GET(^DIC(8,SDDATA,0))
+13 ;Append Local Eligibility IEN and Name
+14 SET SDDV(SDFIELD)=$GET(SDDATA)_";"_$PIECE(SDELIG,"^")
+15 ;Append National Eligibility IEN and Name
+16 SET SDIEN=$PIECE(SDELIG,"^",9)
+17 IF $GET(SDIEN)
Begin DoDot:2
+18 SET SDNAME=$PIECE($GET(^DIC(8.1,SDIEN,0)),"^",1)
+19 SET SDDV(SDFIELD)=SDDV(SDFIELD)_";"_$GET(SDIEN)_";"_$GET(SDNAME)
End DoDot:2
End DoDot:1
+20 QUIT
9 ;Check-In Date/time
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("SCC")),"^",1)
+2 SET SDDV(SDFIELD)=$SELECT($LENGTH(SDSCRTCH)<13:SDSCRTCH,1:$EXTRACT(SDSCRTCH,1,12))
+3 QUIT
10 ;Appt Type IEN and Name
+1 SET SDIEN=$PIECE($GET(SDARRAY("DPT0")),"^",16)
+2 IF $GET(SDIEN)]""
Begin DoDot:1
+3 SET SDNAME=$PIECE($GET(^SD(409.1,SDIEN,0)),"^",1)
+4 SET SDDV(SDFIELD)=$GET(SDIEN)_";"_$GET(SDNAME)
End DoDot:1
+5 QUIT
11 ;Check-Out date/time
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("SCC")),"^",3)
+2 SET SDDV(SDFIELD)=$SELECT($LENGTH(SDSCRTCH)<13:SDSCRTCH,1:$EXTRACT(SDSCRTCH,1,12))
+3 QUIT
12 ;Outpatient Encounter
+1 SET SDDV(SDFIELD)=$PIECE($GET(SDARRAY("DPT0")),"^",20)
+2 QUIT
13 ;Primary Stop Code IEN and AMIS STOP CODE
+1 NEW SDCODES
+2 SET SDCLIEN=+SDARRAY("DPT0")
+3 IF $GET(SDCLIEN)]""
Begin DoDot:1
+4 SET SDCODES=$$GETSTOP(SDCLIEN)
+5 IF SDCODES'=-1
SET SDDV(SDFIELD)=$PIECE(SDCODES,"^",1)
End DoDot:1
+6 QUIT
14 ;Credit Stop Code IEN and AMIS STOP CODE
+1 SET SDCLIEN=+SDARRAY("DPT0")
+2 IF $GET(SDCLIEN)]""
Begin DoDot:1
+3 SET SDCODES=$$GETSTOP(SDCLIEN)
+4 IF SDCODES'=-1
SET SDDV(SDFIELD)=$PIECE(SDCODES,"^",2)
End DoDot:1
+5 QUIT
15 ;Workload Non-Count
+1 SET SDCLIEN=+SDARRAY("DPT0")
+2 IF $GET(SDCLIEN)]""
Begin DoDot:1
+3 SET SDCODES=$$GETSTOP(SDCLIEN)
+4 IF SDCODES'=-1
SET SDDV(SDFIELD)=$PIECE($GET(SDCODES),"^",3)
End DoDot:1
+5 QUIT
16 ;Date Appt Made
+1 SET SDDV(SDFIELD)=$PIECE($PIECE($GET(SDARRAY("DPT0")),"^",19),".")
+2 QUIT
17 ;Desired Date of Appt
+1 SET SDDV(SDFIELD)=$PIECE($PIECE($GET(SDARRAY("DPT1")),"^",1),".")
+2 QUIT
18 ;Purpose of Visit
+1 SET SDDATA=$PIECE($GET(SDARRAY("DPT0")),"^",7)
+2 IF $GET(SDDATA)'=""
Begin DoDot:1
+3 SET SDDATA=SDDATA_$SELECT(SDDATA="1":";C&P",SDDATA="2":";10-10",SDDATA="3":";SV",SDDATA="4":";UV",1:";")
+4 SET SDDV(SDFIELD)=SDDATA
End DoDot:1
+5 QUIT
19 ;EKG Date/time
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("DPT0")),"^",5)
+2 SET SDDV(SDFIELD)=$SELECT($LENGTH(SDSCRTCH)<13:SDSCRTCH,1:$EXTRACT(SDSCRTCH,1,12))
+3 QUIT
20 ;X-Ray Date/time
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("DPT0")),"^",4)
+2 SET SDDV(SDFIELD)=$SELECT($LENGTH(SDSCRTCH)<13:SDSCRTCH,1:$EXTRACT(SDSCRTCH,1,12))
+3 QUIT
21 ;Lab Date/time
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("DPT0")),"^",3)
+2 SET SDDV(SDFIELD)=$SELECT($LENGTH(SDSCRTCH)<13:SDSCRTCH,1:$EXTRACT(SDSCRTCH,1,12))
+3 QUIT
22 ;Status
+1 ; (Status IEN; Status Description; Print Status; Checked In Date/Time;
+2 ; Checked Out Date/Time; Admission Movement IEN)
+3 ;convert to new appt status code
+4 DO 3
+5 SET SDDV(SDFIELD)=$$STATUS^SDAMA308(+$GET(SDARRAY("PAT")),+$GET(SDARRAY("DATE")),+$GET(SDARRAY("DPT0")),$PIECE(SDDV(SDFIELD),";"),$PIECE($GET(SDARRAY("SCC")),"^"),$PIECE($GET(SDARRAY("SCC")),"^",3),$PIECE($GET(SDARRAY("DPT0")),"^",20))
+6 QUIT
23 ;X-Ray Films
+1 NEW SDRECS
+2 ;Get Clinic IEN, X-Ray Films Required
+3 SET SDIEN=+$GET(SDARRAY("DPT0"))
+4 SET SDRECS=$PIECE($GET(^SC(SDIEN,"RAD")),"^")
+5 ;Translate Lower Case to Upper
+6 SET SDRECS=$TRANSLATE(SDRECS,"ny","NY")
+7 SET SDDATA=$SELECT(SDRECS["Y":"Y",1:"N")
+8 SET SDDV(SDFIELD)=SDDATA
+9 QUIT
24 ;Auto-Rebooked Appt. Date/Time
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("DPT0")),"^",10)
+2 SET SDDV(SDFIELD)=$SELECT($LENGTH(SDSCRTCH)<13:SDSCRTCH,1:$EXTRACT(SDSCRTCH,1,12))
+3 QUIT
25 ;No-Show/Cancel Date/Time
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("DPT0")),"^",14)
+2 SET SDDV(SDFIELD)=$SELECT($LENGTH(SDSCRTCH)<13:SDSCRTCH,1:$EXTRACT(SDSCRTCH,1,12))
+3 QUIT
+4 ;This field is only associated with appt info from RSA
+5 ;(No VistA Scheduling Value Exists)
26 ;RSA Appointment ID
+1 QUIT
27 ;2507 Request IEN
+1 ;N SDREQ
+2 ;retrieve 2507 request for patient's appt
+3 ;S SDREQ=$$GET2507^DVBCMKLK(+$G(SDARRAY("PAT")),$G(SDARRAY("DATE")))
+4 ;S SDDV(SDFIELD)=$S((SDREQ>0):SDREQ,1:"")
+5 QUIT
28 ;Data Entry Clerk DUZ and Name
+1 NEW SDSTAT
+2 ;determine appt status
SET SDSTAT=$PIECE($GET(SDARRAY("DPT0")),"^",2)
+3 ;Appt is deleted from ^SC when appt is cancelled
+4 SET SDSCRTCH=$SELECT(SDSTAT["C":$PIECE($GET(SDARRAY("DPT0")),"^",18),1:$PIECE($GET(SDARRAY("SC0")),"^",6))
+5 if (+SDSCRTCH)
SET SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
+6 QUIT
29 ;No-Show/Cancelled By DUZ and Name
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("DPT0")),"^",12)
+2 if (+SDSCRTCH)
SET SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
+3 QUIT
30 ;Check-In User DUZ and Name
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("SCC")),"^",2)
+2 if (+SDSCRTCH)
SET SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
+3 QUIT
31 ;Check-Out User DUZ and Name
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("SCC")),"^",4)
+2 if (+SDSCRTCH)
SET SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(200,SDSCRTCH,.01)
+3 QUIT
32 ;Cancellation Reason IEN and Name
+1 SET SDSCRTCH=$PIECE($GET(SDARRAY("DPT0")),"^",15)
+2 if (+SDSCRTCH)
SET SDDV(SDFIELD)=SDSCRTCH_";"_$$GET1^DIQ(409.2,SDSCRTCH,.01)
+3 QUIT
33 ;Consult Link IEN
+1 SET SDDV(SDFIELD)=$GET(SDARRAY("SCONS"))
+2 QUIT
GETSTOP(SDCLIEN) ;Primary Stop Code, Credit Stop Code, Non-Count
+1 ; return codes or -1 if bad clinic
+2 NEW SDPSC,SDPSCIEN,SDCSC,SDCSCIEN,SDNC,SDCODES
+3 IF +$GET(SDCLIEN)=0
SET SDCODES=-1
+4 IF +$GET(SDCLIEN)'=0
Begin DoDot:1
+5 ;make sure clinic is on ^SC
+6 IF '$DATA(^SC(SDCLIEN))
SET SDCODES=-1
QUIT
+7 ;get primary stop code ien
+8 SET SDPSCIEN=$PIECE($GET(^SC(SDCLIEN,0)),"^",7)
+9 ;get credit stop code ien
+10 SET SDCSCIEN=$PIECE($GET(^SC(SDCLIEN,0)),"^",18)
+11 IF $GET(SDPSCIEN)
SET SDPSC=$PIECE($GET(^DIC(40.7,SDPSCIEN,0)),"^",2)
+12 IF $GET(SDCSCIEN)
SET SDCSC=$PIECE($GET(^DIC(40.7,SDCSCIEN,0)),"^",2)
+13 ;get workload non-count
+14 SET SDNC=$PIECE($GET(^SC(SDCLIEN,0)),"^",17)
+15 SET SDNC=$SELECT($GET(SDNC)="Y":"Y",1:"N")
+16 SET SDCODES=$GET(SDPSCIEN)_";"_$GET(SDPSC)_"^"_$GET(SDCSCIEN)_";"_$GET(SDCSC)_"^"_SDNC
End DoDot:1
+17 QUIT SDCODES
