BSDX27 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
Q
;
PADISPD(BSDXY,BSDXPAT) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("PADISP^BSDX27(.BSDXY,BSDXPAT)")
Q
;
PADISP(BSDXY,BSDXPAT) ;EP
;Return recordset of patient appointments used in listing
;a patient's appointments and generating patient letters.
;Called by rpc BSDX PATIENT APPT DISPLAY
;
N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ
N BSDXSTRT
N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
S BSDXY="^BSDXTMP("_$J_")"
S BSDXI=0
S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
S X="ERROR^BSDX27",@^%ZOSF("TRAP")
;Get patient info
;
I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q
I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q
S BSDXNOD=$$PATINFO(BSDXPAT)
S BSDXNAM=$P(BSDXNOD,U) ;NAME
S BSDXSEX=$P(BSDXNOD,U,2) ;SEX
S BSDXDOB=$P(BSDXNOD,U,3) ;DOB
S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2)
S BSDXSTRE=$P(BSDXNOD,U,5) ;Street
S BSDXCITY=$P(BSDXNOD,U,6) ;City
S BSDXST=$P(BSDXNOD,U,7) ;State
S BSDXZIP=$P(BSDXNOD,U,8) ;zip
S BSDXPHON=$P(BSDXNOD,U,9) ;homephone
;
;Organize ^DPT(BSDXPAT,"S," nodes
; into BSDXDPT(CLINIC,DATE)
;
I $D(^DPT(BSDXPAT,"S")) S BSDXDT=0 F S BSDXDT=$O(^DPT(BSDXPAT,"S",BSDXDT)) Q:'+BSDXDT D
. S BSDXNOD=$G(^DPT(BSDXPAT,"S",BSDXDT,0))
. S BSDXCID=$P(BSDXNOD,U)
. Q:'+BSDXCID
. Q:'$D(^SC(BSDXCID,0))
. S BSDXDPT(BSDXCID,BSDXDT)=BSDXNOD
;
;$O Through ^BSDX("CPAT",
S BSDXIEN=0
I $D(^BSDXAPPT("CPAT",BSDXPAT)) F S BSDXIEN=$O(^BSDXAPPT("CPAT",BSDXPAT,BSDXIEN)) Q:'BSDXIEN D
. N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN
. S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
. Q:BSDXNOD=""
. Q:$P(BSDXNOD,U,12)]"" ;CANCELLED
. S Y=$P(BSDXNOD,U)
. Q:'+Y
. X ^DD("DD") S Y=$TR(Y,"@"," ")
. S BSDXAPT=Y ;Appointment date time
. S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by
. S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
. S Y=$P(BSDXNOD,U,9) ;Date Appointment Made
. I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
. S BSDXMADE=Y
. ;NOTE
. S BSDXNOT=""
. I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ D
. . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))
. . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
. . S BSDXNOT=BSDXNOT_BSDXLIN
. ;Resource
. S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE
. Q:'+BSDXCID
. Q:'$D(^BSDXRES(BSDXCID,0))
. S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node
. Q:BSDXCNOD=""
. S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource
. S BSDX44=$P(BSDXCNOD,U,4) ;File 44 pointer
. ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from
. ;the BSDXDPT array and delete the BSDXDPT node
. S BSDXTYPE=""
. I +BSDX44,$D(BSDXDPT(BSDX44,$P(BSDXNOD,U))) D ;BSDXNOD is the BSDX APPOINTMENT node
. . S BSDXDNOD=BSDXDPT(BSDX44,$P(BSDXNOD,U)) ;BSDXDNOD is a copy of the ^DPT(PAT,"S" node
. . S BSDXTYPE=$$STATUS(BSDXPAT,$P(BSDXNOD,U),BSDXDNOD) ;IHS/OIT/HMW 20050208 Added
. . K BSDXDPT(BSDX44,$P(BSDXNOD,U))
. S BSDXI=BSDXI+1
. S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
. Q
;
;Go through remaining BSDXDPT( entries
I $D(BSDXDPT) S BSDX44=0 D
. F S BSDX44=$O(BSDXDPT(BSDX44)) Q:'+BSDX44 S BSDXDT=0 D
. . F S BSDXDT=$O(BSDXDPT(BSDX44,BSDXDT)) Q:'+BSDXDT D
. . . S BSDXDNOD=BSDXDPT(BSDX44,BSDXDT)
. . . S Y=BSDXDT
. . . Q:'+Y
. . . X ^DD("DD") S Y=$TR(Y,"@"," ")
. . . S BSDXAPT=Y
. . . S BSDXTYPE=$$STATUS(BSDXPAT,BSDXDT,BSDXDNOD) ;IHS/OIT/HMW 20050208 Added
. . . S BSDXCLN=$P($G(^SC(BSDX44,0)),U)
. . . S BSDXCLRK=$P(BSDXDNOD,U,18)
. . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
. . . S Y=$P(BSDXDNOD,U,19)
. . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
. . . S BSDXMADE=Y
. . . S BSDXNOT=""
. . . S BSDXI=BSDXI+1
. . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
. . . K BSDXDPT(BSDX44,BSDXDT)
;
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
STATUS(PAT,DATE,NODE) ; returns appt status
;IHS/OIT/HMW 20050208 Added from BSDDPA
NEW TYP
S TYP=$$APPTYP^BSDU2(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^BSDU2(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT"
I $$CI^BSDU2(PAT,+NODE,DATE) Q TYP_" - CHECKED IN"
Q TYP
;
ERROR ;
D ERR("RPMS Error")
Q
;
ERR(ERRNO) ;Error processing
S:'$D(BSDXI) BSDXI=999
I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
E S BSDXERR=ERRNO
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)="^^^^^^^^^^^^^^^"_$C(30)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
PATINFO(BSDXPAT) ;EP
;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien BSDXPAT
;DOB is in external format
;HRN depends on existence of DUZ(2)
;
N BSDXNOD,BSDXNAM,BSDXSEX,BSDXDOB,BSDXHRN,BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
S BSDXNOD=^DPT(+BSDXPAT,0)
S BSDXNAM=$P(BSDXNOD,U) ;NAME
S BSDXSEX=$P(BSDXNOD,U,2)
S BSDXSEX=$S(BSDXSEX="F":"FEMALE",BSDXSEX="M":"MALE",1:"")
S Y=$P(BSDXNOD,U,3) I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ")
S BSDXDOB=Y ;DOB
S BSDXHRN=""
I $D(DUZ(2)) I DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN
;
S BSDXNOD=$G(^DPT(+BSDXPAT,.11))
S (BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP)=""
I BSDXNOD]"" D
. S BSDXSTRT=$E($P(BSDXNOD,U),1,50) ;STREET
. S BSDXCITY=$P(BSDXNOD,U,4) ;CITY
. S BSDXST=$P(BSDXNOD,U,5) ;STATE
. I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2)
. S BSDXZIP=$P(BSDXNOD,U,6) ;ZIP
;
S BSDXNOD=$G(^DPT(+BSDXPAT,.13)) ;PHONE
S BSDXPHON=$P(BSDXNOD,U)
;
Q BSDXNAM_U_BSDXSEX_U_BSDXDOB_U_BSDXHRN_U_BSDXSTRT_U_BSDXCITY_U_BSDXST_U_BSDXZIP_U_BSDXPHON
;
CLDISPD(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
Q
;
CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND,BSDXWI) ;EP
;Return recordset of patient appointments
;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
;Used in listing a patient's appointments and generating patient letters.
;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
;BSDXBEG and BSDXEND are in external date form.
;BSDXWI = return only appointments where the WALKIN field is yes
;Called by BSDX CLINIC LETTERS
;
N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT
N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN
N BSDXSTRT
N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
S BSDXY="^BSDXTMP("_$J_")"
K ^BSDXTMP($J)
S BSDXI=0
S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
S X="ERROR^BSDX27",@^%ZOSF("TRAP")
;
;Convert beginning and ending dates
;
S X=BSDXBEG,%DT="X" D ^%DT S BSDXBEG=$P(Y,"."),BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
I Y=-1 D ERR(BSDXI,0,"Routine: BSDX27, Error: Invalid Date") Q
S X=BSDXEND,%DT="X" D ^%DT S BSDXEND=$P(Y,"."),BSDXEND=BSDXEND_".9999"
I Y=-1 D ERR(BSDXI,0,"Routine: BSDX27, Error: Invalid Date") Q
I BSDXCLST="" D ERR(BSDXI,0,"Routine: BSDX27, Error: Null clinic list") Q
;
;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)
;
F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D
. S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN=""
. S BSDXSTRT=BSDXBEG F S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT Q:BSDXSTRT>BSDXEND D
. . S BSDXAID=0 F S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID D
. . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))
. . . Q:BSDXNOD=""
. . . Q:$P(BSDXNOD,U,12)]"" ;CANCELLED
. . . I '$G(BSDXWI),$P(BSDXNOD,U,13)="y" Q ;DO NOT ALLOW WALKIN
. . . I $G(BSDXWI),$P(BSDXNOD,U,13)'="y" Q ;ONLY ALLOW WALKIN
. . . S Y=$P(BSDXNOD,U)
. . . Q:'+Y
. . . X ^DD("DD") S Y=$TR(Y,"@"," ")
. . . S BSDXAPT=Y ;Appointment date time
. . . ;
. . . ;NOTE
. . . S BSDXNOT=""
. . . I $D(^BSDXAPPT(BSDXAID,1,0)) S BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAID,1,BSDXQ)) Q:'+BSDXQ D
. . . . S BSDXLIN=$G(^BSDXAPPT(BSDXAID,1,BSDXQ,0))
. . . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
. . . . S BSDXNOT=BSDXNOT_BSDXLIN
. . . ;
. . . S BSDXPAT=$P(BSDXNOD,U,5)
. . . S BSDXPNOD=$$PATINFO(BSDXPAT)
. . . S BSDXNAM=$P(BSDXPNOD,U) ;NAME
. . . S BSDXSEX=$P(BSDXPNOD,U,2) ;SEX
. . . S BSDXDOB=$P(BSDXPNOD,U,3) ;DOB
. . . S BSDXHRN=$P(BSDXPNOD,U,4) ;Health Record Number for location DUZ(2)
. . . S BSDXSTRE=$P(BSDXPNOD,U,5) ;Street
. . . S BSDXCITY=$P(BSDXPNOD,U,6) ;City
. . . S BSDXST=$P(BSDXPNOD,U,7) ;State
. . . S BSDXZIP=$P(BSDXPNOD,U,8) ;zip
. . . S BSDXPHON=$P(BSDXPNOD,U,9) ;homephone
. . . S BSDXTYPE="" ;Type/status doesn't exist for BSDX APPT clinics and it's not needed for clinic letters
. . . S BSDXCLRK=$P(BSDXNOD,U,8)
. . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
. . . S Y=$P(BSDXNOD,U,9)
. . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
. . . S BSDXMADE=Y
. . . S BSDXI=BSDXI+1
. . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
;
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
CLDISPW(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
;Return recordset of patient walk-in appointments
;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
;Used in listing a patient's walk-in appointments and generating patient letters.
;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
;BSDXBEG and BSDXEND are in external date form.
;Called by BSDX CLINIC LETTERS WALKIN
S:$G(U)="" U="^"
D CLDISP(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND,1)
Q
BSDX27 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
+4 QUIT
+5 ;
PADISPD(BSDXY,BSDXPAT) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("PADISP^BSDX27(.BSDXY,BSDXPAT)")
+4 QUIT
+5 ;
PADISP(BSDXY,BSDXPAT) ;EP
+1 ;Return recordset of patient appointments used in listing
+2 ;a patient's appointments and generating patient letters.
+3 ;Called by rpc BSDX PATIENT APPT DISPLAY
+4 ;
+5 NEW BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ
+6 NEW BSDXSTRT
+7 NEW BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
+8 SET BSDXY="^BSDXTMP("_$JOB_")"
+9 SET BSDXI=0
+10 SET ^BSDXTMP($JOB,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
+11 SET ^BSDXTMP($JOB,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$CHAR(30)
+12 SET X="ERROR^BSDX27"
SET @^%ZOSF("TRAP")
+13 ;Get patient info
+14 ;
+15 IF '+BSDXPAT
SET ^BSDXTMP($JOB,1)=$CHAR(31)
QUIT
+16 IF '$DATA(^DPT(+BSDXPAT,0))
SET ^BSDXTMP($JOB,1)=$CHAR(31)
QUIT
+17 SET BSDXNOD=$$PATINFO(BSDXPAT)
+18 ;NAME
SET BSDXNAM=$PIECE(BSDXNOD,U)
+19 ;SEX
SET BSDXSEX=$PIECE(BSDXNOD,U,2)
+20 ;DOB
SET BSDXDOB=$PIECE(BSDXNOD,U,3)
+21 ;Health Record Number for location DUZ(2)
SET BSDXHRN=$PIECE(BSDXNOD,U,4)
+22 ;Street
SET BSDXSTRE=$PIECE(BSDXNOD,U,5)
+23 ;City
SET BSDXCITY=$PIECE(BSDXNOD,U,6)
+24 ;State
SET BSDXST=$PIECE(BSDXNOD,U,7)
+25 ;zip
SET BSDXZIP=$PIECE(BSDXNOD,U,8)
+26 ;homephone
SET BSDXPHON=$PIECE(BSDXNOD,U,9)
+27 ;
+28 ;Organize ^DPT(BSDXPAT,"S," nodes
+29 ; into BSDXDPT(CLINIC,DATE)
+30 ;
+31 IF $DATA(^DPT(BSDXPAT,"S"))
SET BSDXDT=0
FOR
SET BSDXDT=$ORDER(^DPT(BSDXPAT,"S",BSDXDT))
IF '+BSDXDT
QUIT
Begin DoDot:1
+32 SET BSDXNOD=$GET(^DPT(BSDXPAT,"S",BSDXDT,0))
+33 SET BSDXCID=$PIECE(BSDXNOD,U)
+34 IF '+BSDXCID
QUIT
+35 IF '$DATA(^SC(BSDXCID,0))
QUIT
+36 SET BSDXDPT(BSDXCID,BSDXDT)=BSDXNOD
End DoDot:1
+37 ;
+38 ;$O Through ^BSDX("CPAT",
+39 SET BSDXIEN=0
+40 IF $DATA(^BSDXAPPT("CPAT",BSDXPAT))
FOR
SET BSDXIEN=$ORDER(^BSDXAPPT("CPAT",BSDXPAT,BSDXIEN))
IF 'BSDXIEN
QUIT
Begin DoDot:1
+41 NEW BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN
+42 SET BSDXNOD=$GET(^BSDXAPPT(BSDXIEN,0))
+43 IF BSDXNOD=""
QUIT
+44 ;CANCELLED
IF $PIECE(BSDXNOD,U,12)]""
QUIT
+45 SET Y=$PIECE(BSDXNOD,U)
+46 IF '+Y
QUIT
+47 XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+48 ;Appointment date time
SET BSDXAPT=Y
+49 ;Appointment made by
SET BSDXCLRK=$PIECE(BSDXNOD,U,8)
+50 IF +BSDXCLRK
SET BSDXCLRK=$GET(^VA(200,BSDXCLRK,0))
SET BSDXCLRK=$PIECE(BSDXCLRK,U)
+51 ;Date Appointment Made
SET Y=$PIECE(BSDXNOD,U,9)
+52 IF +Y
XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+53 SET BSDXMADE=Y
+54 ;NOTE
+55 SET BSDXNOT=""
+56 IF $DATA(^BSDXAPPT(BSDXIEN,1,0))
SET BSDXNOT=""
SET BSDXQ=0
FOR
SET BSDXQ=$ORDER(^BSDXAPPT(BSDXIEN,1,BSDXQ))
IF '+BSDXQ
QUIT
Begin DoDot:2
+57 SET BSDXLIN=$GET(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))
+58 IF (BSDXLIN'="")&($EXTRACT(BSDXLIN,$LENGTH(BSDXLIN)-1,$LENGTH(BSDXLIN))'=" ")
SET BSDXLIN=BSDXLIN_" "
+59 SET BSDXNOT=BSDXNOT_BSDXLIN
End DoDot:2
+60 ;Resource
+61 ;IEN of BSDX RESOURCE
SET BSDXCID=$PIECE(BSDXNOD,U,7)
+62 IF '+BSDXCID
QUIT
+63 IF '$DATA(^BSDXRES(BSDXCID,0))
QUIT
+64 ;BSDX RESOURCE node
SET BSDXCNOD=$GET(^BSDXRES(BSDXCID,0))
+65 IF BSDXCNOD=""
QUIT
+66 ;Text name of BSDX Resource
SET BSDXCLN=$PIECE(BSDXCNOD,U)
+67 ;File 44 pointer
SET BSDX44=$PIECE(BSDXCNOD,U,4)
+68 ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from
+69 ;the BSDXDPT array and delete the BSDXDPT node
+70 SET BSDXTYPE=""
+71 ;BSDXNOD is the BSDX APPOINTMENT node
IF +BSDX44
IF $DATA(BSDXDPT(BSDX44,$PIECE(BSDXNOD,U)))
Begin DoDot:2
+72 ;BSDXDNOD is a copy of the ^DPT(PAT,"S" node
SET BSDXDNOD=BSDXDPT(BSDX44,$PIECE(BSDXNOD,U))
+73 ;IHS/OIT/HMW 20050208 Added
SET BSDXTYPE=$$STATUS(BSDXPAT,$PIECE(BSDXNOD,U),BSDXDNOD)
+74 KILL BSDXDPT(BSDX44,$PIECE(BSDXNOD,U))
End DoDot:2
+75 SET BSDXI=BSDXI+1
+76 SET ^BSDXTMP($JOB,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$CHAR(30)
+77 QUIT
End DoDot:1
+78 ;
+79 ;Go through remaining BSDXDPT( entries
+80 IF $DATA(BSDXDPT)
SET BSDX44=0
Begin DoDot:1
+81 FOR
SET BSDX44=$ORDER(BSDXDPT(BSDX44))
IF '+BSDX44
QUIT
SET BSDXDT=0
Begin DoDot:2
+82 FOR
SET BSDXDT=$ORDER(BSDXDPT(BSDX44,BSDXDT))
IF '+BSDXDT
QUIT
Begin DoDot:3
+83 SET BSDXDNOD=BSDXDPT(BSDX44,BSDXDT)
+84 SET Y=BSDXDT
+85 IF '+Y
QUIT
+86 XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+87 SET BSDXAPT=Y
+88 ;IHS/OIT/HMW 20050208 Added
SET BSDXTYPE=$$STATUS(BSDXPAT,BSDXDT,BSDXDNOD)
+89 SET BSDXCLN=$PIECE($GET(^SC(BSDX44,0)),U)
+90 SET BSDXCLRK=$PIECE(BSDXDNOD,U,18)
+91 IF +BSDXCLRK
SET BSDXCLRK=$GET(^VA(200,BSDXCLRK,0))
SET BSDXCLRK=$PIECE(BSDXCLRK,U)
+92 SET Y=$PIECE(BSDXDNOD,U,19)
+93 IF +Y
XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+94 SET BSDXMADE=Y
+95 SET BSDXNOT=""
+96 SET BSDXI=BSDXI+1
+97 SET ^BSDXTMP($JOB,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$CHAR(30)
+98 KILL BSDXDPT(BSDX44,BSDXDT)
End DoDot:3
End DoDot:2
End DoDot:1
+99 ;
+100 SET BSDXI=BSDXI+1
+101 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+102 QUIT
+103 ;
STATUS(PAT,DATE,NODE) ; returns appt status
+1 ;IHS/OIT/HMW 20050208 Added from BSDDPA
+2 NEW TYP
+3 ;sched vs. walkin
SET TYP=$$APPTYP^BSDU2(PAT,DATE)
+4 IF $PIECE(NODE,U,2)["C"
QUIT TYP_" - CANCELLED"
+5 IF $PIECE(NODE,U,2)'="NT"
IF $PIECE(NODE,U,2)["N"
QUIT TYP_" - NO SHOW"
+6 IF $$CO^BSDU2(PAT,+NODE,DATE)
QUIT TYP_" - CHECKED OUT"
+7 IF $$CI^BSDU2(PAT,+NODE,DATE)
QUIT TYP_" - CHECKED IN"
+8 QUIT TYP
+9 ;
ERROR ;
+1 DO ERR("RPMS Error")
+2 QUIT
+3 ;
ERR(ERRNO) ;Error processing
+1 IF '$DATA(BSDXI)
SET BSDXI=999
+2 ;vbObjectError
IF +ERRNO
SET BSDXERR=ERRNO+134234112
+3 IF '$TEST
SET BSDXERR=ERRNO
+4 SET BSDXI=BSDXI+1
+5 SET ^BSDXTMP($JOB,BSDXI)="^^^^^^^^^^^^^^^"_$CHAR(30)
+6 SET BSDXI=BSDXI+1
+7 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+8 QUIT
PATINFO(BSDXPAT) ;EP
+1 ;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien BSDXPAT
+2 ;DOB is in external format
+3 ;HRN depends on existence of DUZ(2)
+4 ;
+5 NEW BSDXNOD,BSDXNAM,BSDXSEX,BSDXDOB,BSDXHRN,BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
+6 SET BSDXNOD=^DPT(+BSDXPAT,0)
+7 ;NAME
SET BSDXNAM=$PIECE(BSDXNOD,U)
+8 SET BSDXSEX=$PIECE(BSDXNOD,U,2)
+9 SET BSDXSEX=$SELECT(BSDXSEX="F":"FEMALE",BSDXSEX="M":"MALE",1:"")
+10 SET Y=$PIECE(BSDXNOD,U,3)
IF Y]""
XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+11 ;DOB
SET BSDXDOB=Y
+12 SET BSDXHRN=""
+13 ;HRN
IF $DATA(DUZ(2))
IF DUZ(2)>0
SET BSDXHRN=$PIECE($GET(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2)
+14 ;
+15 SET BSDXNOD=$GET(^DPT(+BSDXPAT,.11))
+16 SET (BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP)=""
+17 IF BSDXNOD]""
Begin DoDot:1
+18 ;STREET
SET BSDXSTRT=$EXTRACT($PIECE(BSDXNOD,U),1,50)
+19 ;CITY
SET BSDXCITY=$PIECE(BSDXNOD,U,4)
+20 ;STATE
SET BSDXST=$PIECE(BSDXNOD,U,5)
+21 IF +BSDXST
IF $DATA(^DIC(5,+BSDXST,0))
SET BSDXST=$PIECE(^DIC(5,+BSDXST,0),U,2)
+22 ;ZIP
SET BSDXZIP=$PIECE(BSDXNOD,U,6)
End DoDot:1
+23 ;
+24 ;PHONE
SET BSDXNOD=$GET(^DPT(+BSDXPAT,.13))
+25 SET BSDXPHON=$PIECE(BSDXNOD,U)
+26 ;
+27 QUIT BSDXNAM_U_BSDXSEX_U_BSDXDOB_U_BSDXHRN_U_BSDXSTRT_U_BSDXCITY_U_BSDXST_U_BSDXZIP_U_BSDXPHON
+28 ;
CLDISPD(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
+4 QUIT
+5 ;
CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND,BSDXWI) ;EP
+1 ;Return recordset of patient appointments
+2 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
+3 ;Used in listing a patient's appointments and generating patient letters.
+4 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
+5 ;BSDXBEG and BSDXEND are in external date form.
+6 ;BSDXWI = return only appointments where the WALKIN field is yes
+7 ;Called by BSDX CLINIC LETTERS
+8 ;
+9 NEW BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT
+10 NEW BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN
+11 NEW BSDXSTRT
+12 NEW BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
+13 SET BSDXY="^BSDXTMP("_$JOB_")"
+14 KILL ^BSDXTMP($JOB)
+15 SET BSDXI=0
+16 SET ^BSDXTMP($JOB,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
+17 SET ^BSDXTMP($JOB,BSDXI)=^BSDXTMP($JOB,BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$CHAR(30)
+18 SET X="ERROR^BSDX27"
SET @^%ZOSF("TRAP")
+19 ;
+20 ;Convert beginning and ending dates
+21 ;
+22 SET X=BSDXBEG
SET %DT="X"
DO ^%DT
SET BSDXBEG=$PIECE(Y,".")
SET BSDXBEG=BSDXBEG-1
SET BSDXBEG=BSDXBEG_".9999"
+23 IF Y=-1
DO ERR(BSDXI,0,"Routine: BSDX27, Error: Invalid Date")
QUIT
+24 SET X=BSDXEND
SET %DT="X"
DO ^%DT
SET BSDXEND=$PIECE(Y,".")
SET BSDXEND=BSDXEND_".9999"
+25 IF Y=-1
DO ERR(BSDXI,0,"Routine: BSDX27, Error: Invalid Date")
QUIT
+26 IF BSDXCLST=""
DO ERR(BSDXI,0,"Routine: BSDX27, Error: Null clinic list")
QUIT
+27 ;
+28 ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)
+29 ;
+30 FOR BSDXJ=1:1:$LENGTH(BSDXCLST,"|")-1
SET BSDXCID=$PIECE(BSDXCLST,"|",BSDXJ)
Begin DoDot:1
+31 SET BSDXCLN=$GET(^BSDXRES(BSDXCID,0))
SET BSDXCLN=$PIECE(BSDXCLN,U)
IF BSDXCLN=""
QUIT
+32 SET BSDXSTRT=BSDXBEG
FOR
SET BSDXSTRT=$ORDER(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT))
IF '+BSDXSTRT
QUIT
IF BSDXSTRT>BSDXEND
QUIT
Begin DoDot:2
+33 SET BSDXAID=0
FOR
SET BSDXAID=$ORDER(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID))
IF '+BSDXAID
QUIT
Begin DoDot:3
+34 SET BSDXNOD=$GET(^BSDXAPPT(BSDXAID,0))
+35 IF BSDXNOD=""
QUIT
+36 ;CANCELLED
IF $PIECE(BSDXNOD,U,12)]""
QUIT
+37 ;DO NOT ALLOW WALKIN
IF '$GET(BSDXWI)
IF $PIECE(BSDXNOD,U,13)="y"
QUIT
+38 ;ONLY ALLOW WALKIN
IF $GET(BSDXWI)
IF $PIECE(BSDXNOD,U,13)'="y"
QUIT
+39 SET Y=$PIECE(BSDXNOD,U)
+40 IF '+Y
QUIT
+41 XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+42 ;Appointment date time
SET BSDXAPT=Y
+43 ;
+44 ;NOTE
+45 SET BSDXNOT=""
+46 IF $DATA(^BSDXAPPT(BSDXAID,1,0))
SET BSDXQ=0
FOR
SET BSDXQ=$ORDER(^BSDXAPPT(BSDXAID,1,BSDXQ))
IF '+BSDXQ
QUIT
Begin DoDot:4
+47 SET BSDXLIN=$GET(^BSDXAPPT(BSDXAID,1,BSDXQ,0))
+48 IF (BSDXLIN'="")&($EXTRACT(BSDXLIN,$LENGTH(BSDXLIN)-1,$LENGTH(BSDXLIN))'=" ")
SET BSDXLIN=BSDXLIN_" "
+49 SET BSDXNOT=BSDXNOT_BSDXLIN
End DoDot:4
+50 ;
+51 SET BSDXPAT=$PIECE(BSDXNOD,U,5)
+52 SET BSDXPNOD=$$PATINFO(BSDXPAT)
+53 ;NAME
SET BSDXNAM=$PIECE(BSDXPNOD,U)
+54 ;SEX
SET BSDXSEX=$PIECE(BSDXPNOD,U,2)
+55 ;DOB
SET BSDXDOB=$PIECE(BSDXPNOD,U,3)
+56 ;Health Record Number for location DUZ(2)
SET BSDXHRN=$PIECE(BSDXPNOD,U,4)
+57 ;Street
SET BSDXSTRE=$PIECE(BSDXPNOD,U,5)
+58 ;City
SET BSDXCITY=$PIECE(BSDXPNOD,U,6)
+59 ;State
SET BSDXST=$PIECE(BSDXPNOD,U,7)
+60 ;zip
SET BSDXZIP=$PIECE(BSDXPNOD,U,8)
+61 ;homephone
SET BSDXPHON=$PIECE(BSDXPNOD,U,9)
+62 ;Type/status doesn't exist for BSDX APPT clinics and it's not needed for clinic letters
SET BSDXTYPE=""
+63 SET BSDXCLRK=$PIECE(BSDXNOD,U,8)
+64 IF +BSDXCLRK
SET BSDXCLRK=$GET(^VA(200,BSDXCLRK,0))
SET BSDXCLRK=$PIECE(BSDXCLRK,U)
+65 SET Y=$PIECE(BSDXNOD,U,9)
+66 IF +Y
XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+67 SET BSDXMADE=Y
+68 SET BSDXI=BSDXI+1
+69 SET ^BSDXTMP($JOB,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C
HAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+70 ;
+71 SET BSDXI=BSDXI+1
+72 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+73 QUIT
+74 ;
CLDISPW(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
+1 ;Return recordset of patient walk-in appointments
+2 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
+3 ;Used in listing a patient's walk-in appointments and generating patient letters.
+4 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
+5 ;BSDXBEG and BSDXEND are in external date form.
+6 ;Called by BSDX CLINIC LETTERS WALKIN
+7 IF $GET(U)=""
SET U="^"
+8 DO CLDISP(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND,1)
+9 QUIT
