SDEC27 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
;
; ICR
; ---
; 7030 - #2 (appointment record)
; 10061 - DEM^VADPT
;
Q
;
PATAPPTD(SDECY,DFN) ;Return the Patient appointment display
;PATAPPTD(SDECY,DFN) external parameter tag is in SDEC
;Return recordset of patient appointments used in listing
;a patient's appointments and generating patient letters.
;RETURN:
; Global Array in which each array entry contains patient appointment data separated by ^:
; 1. Name
; 2. DOB
; 3. Sex
; 4. HRN
; 5. ApptDate
; 6. Clinic
; 7. TypeStatus
; 8. RESOURCEID
; 9. APPT_MADE_BY
;10. DATE_APPT_MADE
;11. NOTE
;12. STREET
;13. CITY
;14. STATE
;15. ZIP
;16. HOMEPHONE
;17. EESTAT - Patient Status N=NEW E=ESTABLISHED
;
N SDECI,SDECIEN,SDECNOD,SDECNAM,SDECDOB,SDECHRN,SDECSEX,SDECCNID,SDECCNOD,SDECMADE,SDECCLRK,SDECNOT,SDECQ
N EESTAT,SDECSTRT,SDECDPT
N SDECSTRE,SDECCITY,SDECST,SDECZIP,SDECPHON
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S SDECI=0
S ^TMP("SDEC",$J,SDECI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
S ^TMP("SDEC",$J,SDECI)=^(SDECI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^T00030EESTAT"_$C(30)
;Get patient info
;
I '+DFN S ^TMP("SDEC",$J,1)=$C(31) Q
I '$D(^DPT(+DFN,0)) S ^TMP("SDEC",$J,1)=$C(31) Q
S SDECNOD=$$PATINFO(DFN)
S SDECNAM=$P(SDECNOD,U) ;NAME
S SDECSEX=$P(SDECNOD,U,2) ;SEX
S SDECDOB=$P(SDECNOD,U,3) ;DOB
S SDECHRN=$P(SDECNOD,U,4) ;Health Record Number for location DUZ(2)
S SDECSTRE=$P(SDECNOD,U,5) ;Street
S SDECCITY=$P(SDECNOD,U,6) ;City
S SDECST=$P(SDECNOD,U,7) ;State
S SDECZIP=$P(SDECNOD,U,8) ;zip
S SDECPHON=$P(SDECNOD,U,9) ;homephone
;
;Organize ^DPT(DFN,"S," nodes
; into SDECDPT(CLINIC,DATE)
;
I $D(^DPT(DFN,"S")) S SDECDT=0 F S SDECDT=$O(^DPT(DFN,"S",SDECDT)) Q:'+SDECDT D
. S SDECNOD=$G(^DPT(DFN,"S",SDECDT,0))
. S SDECCID=$P(SDECNOD,U)
. Q:'+SDECCID
. Q:'$D(^SC(SDECCID,0))
. S SDECDPT(SDECCID,SDECDT)=SDECNOD
;
;$O Through ^SDEC("CPAT",
S SDECIEN=0
I $D(^SDEC(409.84,"CPAT",DFN)) F S SDECIEN=$O(^SDEC(409.84,"CPAT",DFN,SDECIEN)) Q:'SDECIEN D
. N SDECNOD,SDECAPT,SDECCID,SDECCNOD,SDECCLN,SDEC44,SDECDNOD,SDECSTAT,SDEC,SDECTYPE,SDECLIN
. S SDECNOD=$G(^SDEC(409.84,SDECIEN,0))
. Q:SDECNOD=""
. Q:$P(SDECNOD,U,12)]"" ;CANCELLED
. S Y=$P(SDECNOD,U)
. Q:'+Y
.;
.; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
.;
. S SDECAPT=$$FMTONET^SDECDATE(Y,"Y") ;
. ;X ^DD("DD") S Y=$TR(Y,"@"," ")
. ;S SDECAPT=Y ;Appointment date time
. S SDECCLRK=$P(SDECNOD,U,8) ;Appointment made by
. S:+SDECCLRK SDECCLRK=$G(^VA(200,SDECCLRK,0)),SDECCLRK=$P(SDECCLRK,U)
. S Y=$P(SDECNOD,U,9) ;Date Appointment Made
. S SDECMADE=$$FMTONET^SDECDATE(Y,"Y") ;
. ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
. ;S SDECMADE=Y
. ;NOTE
. S SDECNOT=""
. I $D(^SDEC(409.84,SDECIEN,1,0)) S SDECNOT="",SDECQ=0 F S SDECQ=$O(^SDEC(409.84,SDECIEN,1,SDECQ)) Q:'+SDECQ D
. . S SDECLIN=$G(^SDEC(409.84,SDECIEN,1,SDECQ,0))
. . S:(SDECLIN'="")&($E(SDECLIN,$L(SDECLIN)-1,$L(SDECLIN))'=" ") SDECLIN=SDECLIN_" "
. . S SDECNOT=SDECNOT_SDECLIN
. ;Resource
. S SDECCID=$P(SDECNOD,U,7) ;IEN of SDEC RESOURCE
. Q:'+SDECCID
. Q:'$D(^SDEC(409.831,SDECCID,0))
. S SDECCNOD=$G(^SDEC(409.831,SDECCID,0)) ;SDEC RESOURCE node
. Q:SDECCNOD=""
. S SDECCLN=$P(SDECCNOD,U) ;Text name of SDEC Resource
. S SDEC44=$P(SDECCNOD,U,4) ;File 44 pointer
. ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from
. ;the SDECDPT array and delete the SDECDPT node
. S SDECTYPE=""
. I +SDEC44,$D(SDECDPT(SDEC44,$P(SDECNOD,U))) D ;SDECNOD is the SDEC APPOINTMENT node
. . S SDECDNOD=SDECDPT(SDEC44,$P(SDECNOD,U)) ;SDECDNOD is a copy of the ^DPT(PAT,"S" node
. . S SDECTYPE=$$STATUS(DFN,$P(SDECNOD,U),SDECDNOD)
. . K SDECDPT(SDEC44,$P(SDECNOD,U))
. S EESTAT=$$GET1^DIQ(409.84,SDECIEN_",",.23,"E")
. S SDECI=SDECI+1
. S ^TMP("SDEC",$J,SDECI)=SDECNAM_"^"_SDECDOB_"^"_SDECSEX_"^"_SDECHRN_"^"_SDECAPT_"^"_SDECCLN_"^"_SDECTYPE_"^"_SDECCID_"^"_SDECCLRK_"^"_SDECMADE_"^"_SDECNOT_"^"_SDECSTRE_"^"_SDECCITY_"^"_SDECST_"^"_SDECZIP_"^"_SDECPHON_"^"_EESTAT_$C(30)
. Q
;
;Go through remaining SDECDPT( entries
I $D(SDECDPT) S SDEC44=0 D
. F S SDEC44=$O(SDECDPT(SDEC44)) Q:'+SDEC44 S SDECDT=0 D
. . F S SDECDT=$O(SDECDPT(SDEC44,SDECDT)) Q:'+SDECDT D
. . . S SDECDNOD=SDECDPT(SDEC44,SDECDT)
. . . S Y=SDECDT
. . . Q:'+Y
. . . ;
. . . ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
. . . ;
. . . S SDECAPT=$$FMTONET^SDECDATE(Y,"Y") ;
. . . ;X ^DD("DD") S Y=$TR(Y,"@"," ")
. . . ;S SDECAPT=Y
. . . S SDECTYPE=$$STATUS(DFN,SDECDT,SDECDNOD) ;IHS/OIT/HMW 20050208 Added
. . . S SDECCLN=$P($G(^SC(SDEC44,0)),U)
. . . S SDECCLRK=$P(SDECDNOD,U,18)
. . . S:+SDECCLRK SDECCLRK=$G(^VA(200,SDECCLRK,0)),SDECCLRK=$P(SDECCLRK,U)
. . . S Y=$P(SDECDNOD,U,19)
. . . S SDECMADE=$$FMTONET^SDECDATE(Y,"Y") ;
. . . ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
. . . ;S SDECMADE=Y
. . . S SDECNOT=""
. . . S SDECI=SDECI+1
. . . S ^TMP("SDEC",$J,SDECI)=SDECNAM_"^"_SDECDOB_"^"_SDECSEX_"^"_SDECHRN_"^"_SDECAPT_"^"_SDECCLN_"^"_SDECTYPE_"^"_"^"_SDECCLRK_"^"_SDECMADE_"^"_SDECNOT_"^"_SDECSTRE_"^"_SDECCITY_"^"_SDECST_"^"_SDECZIP_"^"_SDECPHON_"^"_$C(30)
. . . K SDECDPT(SDEC44,SDECDT)
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
STATUS(PAT,DATE,NODE) ; returns appt status
NEW TYP
S TYP=$$APPTYP^SDECU2(PAT,DATE) ;sched vs. walkin
I $P(NODE,U,2)["C" Q TYP_" - CANCELLED"
I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW"
I $$CO^SDECU2(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT"
I $$CI^SDECU2(PAT,+NODE,DATE) Q TYP_" - CHECKED IN"
Q TYP
;
ERROR ;
D ERR("VISTA Error")
Q
;
ERR(ERRNO) ;Error processing
N SDECERR
S:'$D(SDECI) SDECI=999
S SDECERR=ERRNO
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="^^^^^^^^^^^^^^^"_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
PATINFO(DFN) ;EP
;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien DFN
;DOB is in external format
;HRN depends on existence of DUZ(2)
;
N SDECNOD,SDECNAM,SDECSEX,SDECDOB,SDECHRN,SDECSTRT,SDECCITY,SDECST,SDECZIP,SDECPHON
S SDECNOD=^DPT(+DFN,0)
S SDECNAM=$P(SDECNOD,U) ;NAME
S SDECSEX=$P(SDECNOD,U,2)
S SDECSEX=$S(SDECSEX="F":"FEMALE",SDECSEX="M":"MALE",1:"")
;
; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
;
S Y=$P(SDECNOD,U,3) ;I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ")
I Y]"" S Y=$$FMTONET^SDECDATE(Y,"Y") ;
S SDECDOB=Y ;DOB
S SDECHRN=""
I $D(DUZ(2)) I DUZ(2)>0 S SDECHRN=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2) ;HRN
;
S SDECNOD=$G(^DPT(+DFN,.11))
S (SDECSTRT,SDECCITY,SDECST,SDECZIP)=""
I SDECNOD]"" D
. S SDECSTRT=$E($P(SDECNOD,U),1,50) ;STREET
. S SDECCITY=$P(SDECNOD,U,4) ;CITY
. S SDECST=$P(SDECNOD,U,5) ;STATE
. I +SDECST,$D(^DIC(5,+SDECST,0)) S SDECST=$P(^DIC(5,+SDECST,0),U,2)
. S SDECZIP=$P(SDECNOD,U,6) ;ZIP
;
S SDECNOD=$G(^DPT(+DFN,.13)) ;PHONE
S SDECPHON=$P(SDECNOD,U)
;
Q SDECNAM_U_SDECSEX_U_SDECDOB_U_SDECHRN_U_SDECSTRT_U_SDECCITY_U_SDECST_U_SDECZIP_U_SDECPHON
;
CLINLET(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) ;CLINIC LETTERS Appointment data
;CLINLET(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) external parameter tag is in SDEC
;Return recordset of patient appointments
;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
;Used in listing a patient's appointments and generating patient letters.
;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
;SDECBEG and SDECEND are in external date form.
;SDECWI = return only appointments where the WALKIN field is yes
;RETURN:
; Global Array in which each array entry contains the following Clinic Letter data separated by ^:
; 1. Name
; 2. DOB
; 3. Sex
; 4. HRN
; 5. ApptDate
; 6. Clinic
; 7. TypeStatus
; 8. RESOURCEID
; 9. APPT_MADE_BY
;10. DATE_APPT_MADE
;11. NOTE
;12. STREET
;13. CITY
;14. STATE
;15. ZIP
;16. HOMEPHONE
;
N SDECI,SDECNOD,SDECNAM,SDECDOB,SDECHRN,SDECSEX,SDECCID,SDECCNOD,SDECDT
N SDECJ,SDECAID,DFN,SDECPNOD,SDECCLN,SDECCLRK,SDECMADE,SDECNOT,SDECLIN
N SDECSTRT,%DT,X,Y
N SDECSTRE,SDECCITY,SDECST,SDECZIP,SDECPHON
S SDECY="^TMP(""SDEC"","_$J_")"
K ^TMP("SDEC",$J)
S SDECI=0
S ^TMP("SDEC",$J,SDECI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
;
;Convert beginning and ending dates
;
S X=SDECBEG,%DT="X" D ^%DT S SDECBEG=$P(Y,"."),SDECBEG=SDECBEG-1,SDECBEG=SDECBEG_".9999"
I Y=-1 D ERR(SDECI,0,"Routine: SDEC27, Error: Invalid Date") Q
S X=SDECEND,%DT="X" D ^%DT S SDECEND=$P(Y,"."),SDECEND=SDECEND_".9999"
I Y=-1 D ERR(SDECI,0,"Routine: SDEC27, Error: Invalid Date") Q
I SDECCLST="" D ERR(SDECI,0,"Routine: SDEC27, Error: Null clinic list") Q
;
;For each clinic in SDECCLST $O through ^SDEC(409.84,"ARSRC",ResourceIEN,FMDate,ApptIEN)
;
F SDECJ=1:1:$L(SDECCLST,"|")-1 S SDECCID=$P(SDECCLST,"|",SDECJ) D
. S SDECCLN=$G(^SDEC(409.831,SDECCID,0)) S SDECCLN=$P(SDECCLN,U) Q:SDECCLN=""
. S SDECSTRT=SDECBEG F S SDECSTRT=$O(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT)) Q:'+SDECSTRT Q:SDECSTRT>SDECEND D
. . S SDECAID=0 F S SDECAID=$O(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT,SDECAID)) Q:'+SDECAID D
. . . S SDECNOD=$G(^SDEC(409.84,SDECAID,0))
. . . Q:SDECNOD=""
. . . Q:$P(SDECNOD,U,12)]"" ;CANCELLED
. . . I '$G(SDECWI),$P(SDECNOD,U,13)="y" Q ;DO NOT ALLOW WALKIN
. . . I $G(SDECWI),$P(SDECNOD,U,13)'="y" Q ;ONLY ALLOW WALKIN
. . . S Y=$P(SDECNOD,U)
. . . Q:'+Y
. . . ;
. . . ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
. . . ;
. . . S SDECAPT=$$FMTONET^SDECDATE(Y,"Y") ;
. . . ;X ^DD("DD") S Y=$TR(Y,"@"," ")
. . . ;S SDECAPT=Y ;Appointment date time
. . . ;
. . . ;NOTE
. . . S SDECNOT=""
. . . I $D(^SDEC(409.84,SDECAID,1,0)) S SDECQ=0 F S SDECQ=$O(^SDEC(409.84,SDECAID,1,SDECQ)) Q:'+SDECQ D
. . . . S SDECLIN=$G(^SDEC(409.84,SDECAID,1,SDECQ,0))
. . . . S:(SDECLIN'="")&($E(SDECLIN,$L(SDECLIN)-1,$L(SDECLIN))'=" ") SDECLIN=SDECLIN_" "
. . . . S SDECNOT=SDECNOT_SDECLIN
. . . ;
. . . S DFN=$P(SDECNOD,U,5)
. . . S SDECPNOD=$$PATINFO(DFN)
. . . S SDECNAM=$P(SDECPNOD,U) ;NAME
. . . S SDECSEX=$P(SDECPNOD,U,2) ;SEX
. . . S SDECDOB=$P(SDECPNOD,U,3) ;DOB
. . . S SDECHRN=$P(SDECPNOD,U,4) ;Health Record Number for location DUZ(2)
. . . S SDECSTRE=$P(SDECPNOD,U,5) ;Street
. . . S SDECCITY=$P(SDECPNOD,U,6) ;City
. . . S SDECST=$P(SDECPNOD,U,7) ;State
. . . S SDECZIP=$P(SDECPNOD,U,8) ;zip
. . . S SDECPHON=$P(SDECPNOD,U,9) ;homephone
. . . S SDECTYPE="" ;Type/status doesn't exist for SDEC APPT clinics and it's not needed for clinic letters
. . . S SDECCLRK=$P(SDECNOD,U,8)
. . . S:+SDECCLRK SDECCLRK=$G(^VA(200,SDECCLRK,0)),SDECCLRK=$P(SDECCLRK,U)
. . . S Y=$P(SDECNOD,U,9)
. . . ;
. . . ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
. . . ;
. . . S SDECMADE=$$FMTONET^SDECDATE(Y,"Y") ;
. . . ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
. . . ;S SDECMADE=Y
. . . S SDECI=SDECI+1
. . . S ^TMP("SDEC",$J,SDECI)=SDECNAM_"^"_SDECDOB_"^"_SDECSEX_"^"_SDECHRN_"^"_SDECAPT_"^"_SDECCLN_"^"_SDECTYPE_"^"_SDECCID_"^"_SDECCLRK_"^"_SDECMADE_"^"_SDECNOT_"^"_SDECSTRE_"^"_SDECCITY_"^"_SDECST_"^"_SDECZIP_"^"_SDECPHON_$C(30)
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
CLINLETW(SDECY,SDECCLST,SDECBEG,SDECEND) ;CLINIC LETTERS WALK-IN Appointment data for Walk-in Appointments only
;CLINLETW(SDECY,SDECCLST,SDECBEG,SDECEND) external parameter tag is in SDEC
;Return recordset of patient walk-in appointments
;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
;Used in listing a patient's walk-in appointments and generating patient letters.
;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
;SDECBEG and SDECEND are in external date form.
;RETURN:
; Global Array in which each array entry contains the following Clinic Letter data separated by ^:
; 1. Name
; 2. DOB
; 3. Sex
; 4. HRN
; 5. ApptDate
; 6. Clinic
; 7. TypeStatus
; 8. RESOURCEID
; 9. APPT_MADE_BY
;10. DATE_APPT_MADE
;11. NOTE
;12. STREET
;13. CITY
;14. STATE
;15. ZIP
;16. HOMEPHONE
S:$G(U)="" U="^"
D CLINLET(.SDECY,SDECCLST,SDECBEG,SDECEND,1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC27 12885 printed Dec 13, 2024@02:50:21 Page 2
SDEC27 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
+1 ;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
+2 ;
+3 ; ICR
+4 ; ---
+5 ; 7030 - #2 (appointment record)
+6 ; 10061 - DEM^VADPT
+7 ;
+8 QUIT
+9 ;
PATAPPTD(SDECY,DFN) ;Return the Patient appointment display
+1 ;PATAPPTD(SDECY,DFN) external parameter tag is in SDEC
+2 ;Return recordset of patient appointments used in listing
+3 ;a patient's appointments and generating patient letters.
+4 ;RETURN:
+5 ; Global Array in which each array entry contains patient appointment data separated by ^:
+6 ; 1. Name
+7 ; 2. DOB
+8 ; 3. Sex
+9 ; 4. HRN
+10 ; 5. ApptDate
+11 ; 6. Clinic
+12 ; 7. TypeStatus
+13 ; 8. RESOURCEID
+14 ; 9. APPT_MADE_BY
+15 ;10. DATE_APPT_MADE
+16 ;11. NOTE
+17 ;12. STREET
+18 ;13. CITY
+19 ;14. STATE
+20 ;15. ZIP
+21 ;16. HOMEPHONE
+22 ;17. EESTAT - Patient Status N=NEW E=ESTABLISHED
+23 ;
+24 NEW SDECI,SDECIEN,SDECNOD,SDECNAM,SDECDOB,SDECHRN,SDECSEX,SDECCNID,SDECCNOD,SDECMADE,SDECCLRK,SDECNOT,SDECQ
+25 NEW EESTAT,SDECSTRT,SDECDPT
+26 NEW SDECSTRE,SDECCITY,SDECST,SDECZIP,SDECPHON
+27 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+28 KILL @SDECY
+29 SET SDECI=0
+30 SET ^TMP("SDEC",$JOB,SDECI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
+31 SET ^TMP("SDEC",$JOB,SDECI)=^(SDECI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^T00030EESTAT"_$CHAR(30)
+32 ;Get patient info
+33 ;
+34 IF '+DFN
SET ^TMP("SDEC",$JOB,1)=$CHAR(31)
QUIT
+35 IF '$DATA(^DPT(+DFN,0))
SET ^TMP("SDEC",$JOB,1)=$CHAR(31)
QUIT
+36 SET SDECNOD=$$PATINFO(DFN)
+37 ;NAME
SET SDECNAM=$PIECE(SDECNOD,U)
+38 ;SEX
SET SDECSEX=$PIECE(SDECNOD,U,2)
+39 ;DOB
SET SDECDOB=$PIECE(SDECNOD,U,3)
+40 ;Health Record Number for location DUZ(2)
SET SDECHRN=$PIECE(SDECNOD,U,4)
+41 ;Street
SET SDECSTRE=$PIECE(SDECNOD,U,5)
+42 ;City
SET SDECCITY=$PIECE(SDECNOD,U,6)
+43 ;State
SET SDECST=$PIECE(SDECNOD,U,7)
+44 ;zip
SET SDECZIP=$PIECE(SDECNOD,U,8)
+45 ;homephone
SET SDECPHON=$PIECE(SDECNOD,U,9)
+46 ;
+47 ;Organize ^DPT(DFN,"S," nodes
+48 ; into SDECDPT(CLINIC,DATE)
+49 ;
+50 IF $DATA(^DPT(DFN,"S"))
SET SDECDT=0
FOR
SET SDECDT=$ORDER(^DPT(DFN,"S",SDECDT))
if '+SDECDT
QUIT
Begin DoDot:1
+51 SET SDECNOD=$GET(^DPT(DFN,"S",SDECDT,0))
+52 SET SDECCID=$PIECE(SDECNOD,U)
+53 if '+SDECCID
QUIT
+54 if '$DATA(^SC(SDECCID,0))
QUIT
+55 SET SDECDPT(SDECCID,SDECDT)=SDECNOD
End DoDot:1
+56 ;
+57 ;$O Through ^SDEC("CPAT",
+58 SET SDECIEN=0
+59 IF $DATA(^SDEC(409.84,"CPAT",DFN))
FOR
SET SDECIEN=$ORDER(^SDEC(409.84,"CPAT",DFN,SDECIEN))
if 'SDECIEN
QUIT
Begin DoDot:1
+60 NEW SDECNOD,SDECAPT,SDECCID,SDECCNOD,SDECCLN,SDEC44,SDECDNOD,SDECSTAT,SDEC,SDECTYPE,SDECLIN
+61 SET SDECNOD=$GET(^SDEC(409.84,SDECIEN,0))
+62 if SDECNOD=""
QUIT
+63 ;CANCELLED
if $PIECE(SDECNOD,U,12)]""
QUIT
+64 SET Y=$PIECE(SDECNOD,U)
+65 if '+Y
QUIT
+66 ;
+67 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+68 ;
+69 ;
SET SDECAPT=$$FMTONET^SDECDATE(Y,"Y")
+70 ;X ^DD("DD") S Y=$TR(Y,"@"," ")
+71 ;S SDECAPT=Y ;Appointment date time
+72 ;Appointment made by
SET SDECCLRK=$PIECE(SDECNOD,U,8)
+73 if +SDECCLRK
SET SDECCLRK=$GET(^VA(200,SDECCLRK,0))
SET SDECCLRK=$PIECE(SDECCLRK,U)
+74 ;Date Appointment Made
SET Y=$PIECE(SDECNOD,U,9)
+75 ;
SET SDECMADE=$$FMTONET^SDECDATE(Y,"Y")
+76 ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
+77 ;S SDECMADE=Y
+78 ;NOTE
+79 SET SDECNOT=""
+80 IF $DATA(^SDEC(409.84,SDECIEN,1,0))
SET SDECNOT=""
SET SDECQ=0
FOR
SET SDECQ=$ORDER(^SDEC(409.84,SDECIEN,1,SDECQ))
if '+SDECQ
QUIT
Begin DoDot:2
+81 SET SDECLIN=$GET(^SDEC(409.84,SDECIEN,1,SDECQ,0))
+82 if (SDECLIN'="")&($EXTRACT(SDECLIN,$LENGTH(SDECLIN)-1,$LENGTH(SDECLIN))'=" ")
SET SDECLIN=SDECLIN_" "
+83 SET SDECNOT=SDECNOT_SDECLIN
End DoDot:2
+84 ;Resource
+85 ;IEN of SDEC RESOURCE
SET SDECCID=$PIECE(SDECNOD,U,7)
+86 if '+SDECCID
QUIT
+87 if '$DATA(^SDEC(409.831,SDECCID,0))
QUIT
+88 ;SDEC RESOURCE node
SET SDECCNOD=$GET(^SDEC(409.831,SDECCID,0))
+89 if SDECCNOD=""
QUIT
+90 ;Text name of SDEC Resource
SET SDECCLN=$PIECE(SDECCNOD,U)
+91 ;File 44 pointer
SET SDEC44=$PIECE(SDECCNOD,U,4)
+92 ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from
+93 ;the SDECDPT array and delete the SDECDPT node
+94 SET SDECTYPE=""
+95 ;SDECNOD is the SDEC APPOINTMENT node
IF +SDEC44
IF $DATA(SDECDPT(SDEC44,$PIECE(SDECNOD,U)))
Begin DoDot:2
+96 ;SDECDNOD is a copy of the ^DPT(PAT,"S" node
SET SDECDNOD=SDECDPT(SDEC44,$PIECE(SDECNOD,U))
+97 SET SDECTYPE=$$STATUS(DFN,$PIECE(SDECNOD,U),SDECDNOD)
+98 KILL SDECDPT(SDEC44,$PIECE(SDECNOD,U))
End DoDot:2
+99 SET EESTAT=$$GET1^DIQ(409.84,SDECIEN_",",.23,"E")
+100 SET SDECI=SDECI+1
+101 SET ^TMP("SDEC",$JOB,SDECI)=SDECNAM_"^"_SDECDOB_"^"_SDECSEX_"^"_SDECHRN_"^"_SDECAPT_"^"_SDECCLN_"^"_SDECTYPE_"^"_SDECCID_"^"_SDECCLRK_"^"_SDECMADE_"^"_SDECNOT_"^"_SDECSTRE_"^"_SDECCITY_"^"_SDECST_"^"_SDECZIP_"^"_SDECPHON_"^"_EESTAT_
$CHAR(30)
+102 QUIT
End DoDot:1
+103 ;
+104 ;Go through remaining SDECDPT( entries
+105 IF $DATA(SDECDPT)
SET SDEC44=0
Begin DoDot:1
+106 FOR
SET SDEC44=$ORDER(SDECDPT(SDEC44))
if '+SDEC44
QUIT
SET SDECDT=0
Begin DoDot:2
+107 FOR
SET SDECDT=$ORDER(SDECDPT(SDEC44,SDECDT))
if '+SDECDT
QUIT
Begin DoDot:3
+108 SET SDECDNOD=SDECDPT(SDEC44,SDECDT)
+109 SET Y=SDECDT
+110 if '+Y
QUIT
+111 ;
+112 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+113 ;
+114 ;
SET SDECAPT=$$FMTONET^SDECDATE(Y,"Y")
+115 ;X ^DD("DD") S Y=$TR(Y,"@"," ")
+116 ;S SDECAPT=Y
+117 ;IHS/OIT/HMW 20050208 Added
SET SDECTYPE=$$STATUS(DFN,SDECDT,SDECDNOD)
+118 SET SDECCLN=$PIECE($GET(^SC(SDEC44,0)),U)
+119 SET SDECCLRK=$PIECE(SDECDNOD,U,18)
+120 if +SDECCLRK
SET SDECCLRK=$GET(^VA(200,SDECCLRK,0))
SET SDECCLRK=$PIECE(SDECCLRK,U)
+121 SET Y=$PIECE(SDECDNOD,U,19)
+122 ;
SET SDECMADE=$$FMTONET^SDECDATE(Y,"Y")
+123 ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
+124 ;S SDECMADE=Y
+125 SET SDECNOT=""
+126 SET SDECI=SDECI+1
+127 SET ^TMP("SDEC",$JOB,SDECI)=SDECNAM_"^"_SDECDOB_"^"_SDECSEX_"^"_SDECHRN_"^"_SDECAPT_"^"_SDECCLN_"^"_SDECTYPE_"^"_"^"_SDECCLRK_"^"_SDECMADE_"^"_SDECNOT_"^"_SDECSTRE_"^"_SDECCITY_"^"_SDECST_"^"_SDECZIP_"^"_SDECPHON_"^"_$CH
AR(30)
+128 KILL SDECDPT(SDEC44,SDECDT)
End DoDot:3
End DoDot:2
End DoDot:1
+129 ;
+130 SET SDECI=SDECI+1
+131 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+132 QUIT
+133 ;
STATUS(PAT,DATE,NODE) ; returns appt status
+1 NEW TYP
+2 ;sched vs. walkin
SET TYP=$$APPTYP^SDECU2(PAT,DATE)
+3 IF $PIECE(NODE,U,2)["C"
QUIT TYP_" - CANCELLED"
+4 IF $PIECE(NODE,U,2)'="NT"
IF $PIECE(NODE,U,2)["N"
QUIT TYP_" - NO SHOW"
+5 IF $$CO^SDECU2(PAT,+NODE,DATE)
QUIT TYP_" - CHECKED OUT"
+6 IF $$CI^SDECU2(PAT,+NODE,DATE)
QUIT TYP_" - CHECKED IN"
+7 QUIT TYP
+8 ;
ERROR ;
+1 DO ERR("VISTA Error")
+2 QUIT
+3 ;
ERR(ERRNO) ;Error processing
+1 NEW SDECERR
+2 if '$DATA(SDECI)
SET SDECI=999
+3 SET SDECERR=ERRNO
+4 SET SDECI=SDECI+1
+5 SET ^TMP("SDEC",$JOB,SDECI)="^^^^^^^^^^^^^^^"_$CHAR(30)
+6 SET SDECI=SDECI+1
+7 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+8 QUIT
PATINFO(DFN) ;EP
+1 ;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien DFN
+2 ;DOB is in external format
+3 ;HRN depends on existence of DUZ(2)
+4 ;
+5 NEW SDECNOD,SDECNAM,SDECSEX,SDECDOB,SDECHRN,SDECSTRT,SDECCITY,SDECST,SDECZIP,SDECPHON
+6 SET SDECNOD=^DPT(+DFN,0)
+7 ;NAME
SET SDECNAM=$PIECE(SDECNOD,U)
+8 SET SDECSEX=$PIECE(SDECNOD,U,2)
+9 SET SDECSEX=$SELECT(SDECSEX="F":"FEMALE",SDECSEX="M":"MALE",1:"")
+10 ;
+11 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+12 ;
+13 ;I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ")
SET Y=$PIECE(SDECNOD,U,3)
+14 ;
IF Y]""
SET Y=$$FMTONET^SDECDATE(Y,"Y")
+15 ;DOB
SET SDECDOB=Y
+16 SET SDECHRN=""
+17 ;HRN
IF $DATA(DUZ(2))
IF DUZ(2)>0
SET SDECHRN=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
+18 ;
+19 SET SDECNOD=$GET(^DPT(+DFN,.11))
+20 SET (SDECSTRT,SDECCITY,SDECST,SDECZIP)=""
+21 IF SDECNOD]""
Begin DoDot:1
+22 ;STREET
SET SDECSTRT=$EXTRACT($PIECE(SDECNOD,U),1,50)
+23 ;CITY
SET SDECCITY=$PIECE(SDECNOD,U,4)
+24 ;STATE
SET SDECST=$PIECE(SDECNOD,U,5)
+25 IF +SDECST
IF $DATA(^DIC(5,+SDECST,0))
SET SDECST=$PIECE(^DIC(5,+SDECST,0),U,2)
+26 ;ZIP
SET SDECZIP=$PIECE(SDECNOD,U,6)
End DoDot:1
+27 ;
+28 ;PHONE
SET SDECNOD=$GET(^DPT(+DFN,.13))
+29 SET SDECPHON=$PIECE(SDECNOD,U)
+30 ;
+31 QUIT SDECNAM_U_SDECSEX_U_SDECDOB_U_SDECHRN_U_SDECSTRT_U_SDECCITY_U_SDECST_U_SDECZIP_U_SDECPHON
+32 ;
CLINLET(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) ;CLINIC LETTERS Appointment data
+1 ;CLINLET(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) external parameter tag is in SDEC
+2 ;Return recordset of patient appointments
+3 ;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
+4 ;Used in listing a patient's appointments and generating patient letters.
+5 ;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
+6 ;SDECBEG and SDECEND are in external date form.
+7 ;SDECWI = return only appointments where the WALKIN field is yes
+8 ;RETURN:
+9 ; Global Array in which each array entry contains the following Clinic Letter data separated by ^:
+10 ; 1. Name
+11 ; 2. DOB
+12 ; 3. Sex
+13 ; 4. HRN
+14 ; 5. ApptDate
+15 ; 6. Clinic
+16 ; 7. TypeStatus
+17 ; 8. RESOURCEID
+18 ; 9. APPT_MADE_BY
+19 ;10. DATE_APPT_MADE
+20 ;11. NOTE
+21 ;12. STREET
+22 ;13. CITY
+23 ;14. STATE
+24 ;15. ZIP
+25 ;16. HOMEPHONE
+26 ;
+27 NEW SDECI,SDECNOD,SDECNAM,SDECDOB,SDECHRN,SDECSEX,SDECCID,SDECCNOD,SDECDT
+28 NEW SDECJ,SDECAID,DFN,SDECPNOD,SDECCLN,SDECCLRK,SDECMADE,SDECNOT,SDECLIN
+29 NEW SDECSTRT,%DT,X,Y
+30 NEW SDECSTRE,SDECCITY,SDECST,SDECZIP,SDECPHON
+31 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+32 KILL ^TMP("SDEC",$JOB)
+33 SET SDECI=0
+34 SET ^TMP("SDEC",$JOB,SDECI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
+35 SET ^TMP("SDEC",$JOB,SDECI)=^TMP("SDEC",$JOB,SDECI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$CHAR(30)
+36 ;
+37 ;Convert beginning and ending dates
+38 ;
+39 SET X=SDECBEG
SET %DT="X"
DO ^%DT
SET SDECBEG=$PIECE(Y,".")
SET SDECBEG=SDECBEG-1
SET SDECBEG=SDECBEG_".9999"
+40 IF Y=-1
DO ERR(SDECI,0,"Routine: SDEC27, Error: Invalid Date")
QUIT
+41 SET X=SDECEND
SET %DT="X"
DO ^%DT
SET SDECEND=$PIECE(Y,".")
SET SDECEND=SDECEND_".9999"
+42 IF Y=-1
DO ERR(SDECI,0,"Routine: SDEC27, Error: Invalid Date")
QUIT
+43 IF SDECCLST=""
DO ERR(SDECI,0,"Routine: SDEC27, Error: Null clinic list")
QUIT
+44 ;
+45 ;For each clinic in SDECCLST $O through ^SDEC(409.84,"ARSRC",ResourceIEN,FMDate,ApptIEN)
+46 ;
+47 FOR SDECJ=1:1:$LENGTH(SDECCLST,"|")-1
SET SDECCID=$PIECE(SDECCLST,"|",SDECJ)
Begin DoDot:1
+48 SET SDECCLN=$GET(^SDEC(409.831,SDECCID,0))
SET SDECCLN=$PIECE(SDECCLN,U)
if SDECCLN=""
QUIT
+49 SET SDECSTRT=SDECBEG
FOR
SET SDECSTRT=$ORDER(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT))
if '+SDECSTRT
QUIT
if SDECSTRT>SDECEND
QUIT
Begin DoDot:2
+50 SET SDECAID=0
FOR
SET SDECAID=$ORDER(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT,SDECAID))
if '+SDECAID
QUIT
Begin DoDot:3
+51 SET SDECNOD=$GET(^SDEC(409.84,SDECAID,0))
+52 if SDECNOD=""
QUIT
+53 ;CANCELLED
if $PIECE(SDECNOD,U,12)]""
QUIT
+54 ;DO NOT ALLOW WALKIN
IF '$GET(SDECWI)
IF $PIECE(SDECNOD,U,13)="y"
QUIT
+55 ;ONLY ALLOW WALKIN
IF $GET(SDECWI)
IF $PIECE(SDECNOD,U,13)'="y"
QUIT
+56 SET Y=$PIECE(SDECNOD,U)
+57 if '+Y
QUIT
+58 ;
+59 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+60 ;
+61 ;
SET SDECAPT=$$FMTONET^SDECDATE(Y,"Y")
+62 ;X ^DD("DD") S Y=$TR(Y,"@"," ")
+63 ;S SDECAPT=Y ;Appointment date time
+64 ;
+65 ;NOTE
+66 SET SDECNOT=""
+67 IF $DATA(^SDEC(409.84,SDECAID,1,0))
SET SDECQ=0
FOR
SET SDECQ=$ORDER(^SDEC(409.84,SDECAID,1,SDECQ))
if '+SDECQ
QUIT
Begin DoDot:4
+68 SET SDECLIN=$GET(^SDEC(409.84,SDECAID,1,SDECQ,0))
+69 if (SDECLIN'="")&($EXTRACT(SDECLIN,$LENGTH(SDECLIN)-1,$LENGTH(SDECLIN))'=" ")
SET SDECLIN=SDECLIN_" "
+70 SET SDECNOT=SDECNOT_SDECLIN
End DoDot:4
+71 ;
+72 SET DFN=$PIECE(SDECNOD,U,5)
+73 SET SDECPNOD=$$PATINFO(DFN)
+74 ;NAME
SET SDECNAM=$PIECE(SDECPNOD,U)
+75 ;SEX
SET SDECSEX=$PIECE(SDECPNOD,U,2)
+76 ;DOB
SET SDECDOB=$PIECE(SDECPNOD,U,3)
+77 ;Health Record Number for location DUZ(2)
SET SDECHRN=$PIECE(SDECPNOD,U,4)
+78 ;Street
SET SDECSTRE=$PIECE(SDECPNOD,U,5)
+79 ;City
SET SDECCITY=$PIECE(SDECPNOD,U,6)
+80 ;State
SET SDECST=$PIECE(SDECPNOD,U,7)
+81 ;zip
SET SDECZIP=$PIECE(SDECPNOD,U,8)
+82 ;homephone
SET SDECPHON=$PIECE(SDECPNOD,U,9)
+83 ;Type/status doesn't exist for SDEC APPT clinics and it's not needed for clinic letters
SET SDECTYPE=""
+84 SET SDECCLRK=$PIECE(SDECNOD,U,8)
+85 if +SDECCLRK
SET SDECCLRK=$GET(^VA(200,SDECCLRK,0))
SET SDECCLRK=$PIECE(SDECCLRK,U)
+86 SET Y=$PIECE(SDECNOD,U,9)
+87 ;
+88 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+89 ;
+90 ;
SET SDECMADE=$$FMTONET^SDECDATE(Y,"Y")
+91 ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
+92 ;S SDECMADE=Y
+93 SET SDECI=SDECI+1
+94 SET ^TMP("SDEC",$JOB,SDECI)=SDECNAM_"^"_SDECDOB_"^"_SDECSEX_"^"_SDECHRN_"^"_SDECAPT_"^"_SDECCLN_"^"_SDECTYPE_"^"_SDECCID_"^"_SDECCLRK_"^"_SDECMADE_"^"_SDECNOT_"^"_SDECSTRE_"^"_SDECCITY_"^"_SDECST_"^"_SDECZIP_"^"_SDECPHON
_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+95 ;
+96 SET SDECI=SDECI+1
+97 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+98 QUIT
+99 ;
CLINLETW(SDECY,SDECCLST,SDECBEG,SDECEND) ;CLINIC LETTERS WALK-IN Appointment data for Walk-in Appointments only
+1 ;CLINLETW(SDECY,SDECCLST,SDECBEG,SDECEND) external parameter tag is in SDEC
+2 ;Return recordset of patient walk-in appointments
+3 ;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
+4 ;Used in listing a patient's walk-in appointments and generating patient letters.
+5 ;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
+6 ;SDECBEG and SDECEND are in external date form.
+7 ;RETURN:
+8 ; Global Array in which each array entry contains the following Clinic Letter data separated by ^:
+9 ; 1. Name
+10 ; 2. DOB
+11 ; 3. Sex
+12 ; 4. HRN
+13 ; 5. ApptDate
+14 ; 6. Clinic
+15 ; 7. TypeStatus
+16 ; 8. RESOURCEID
+17 ; 9. APPT_MADE_BY
+18 ;10. DATE_APPT_MADE
+19 ;11. NOTE
+20 ;12. STREET
+21 ;13. CITY
+22 ;14. STATE
+23 ;15. ZIP
+24 ;16. HOMEPHONE
+25 if $GET(U)=""
SET U="^"
+26 DO CLINLET(.SDECY,SDECCLST,SDECBEG,SDECEND,1)
+27 QUIT
