SDAMA305.m

SDAMA305 ;BPOIFO/ACS-Filter API Get Data ; 6/21/05 1:50pm

 ;;5.3;Scheduling;**301,347,508,1015**;13 Aug 1993;Build 21

 ;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

SDAMA305  ;BPOIFO/ACS-Filter API Get Data ; 6/21/05 1:50pm

 +1       ;;5.3;Scheduling;**301,347,508,1015**;13 Aug 1993;Build 21

 +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