178 lines
6.3 KiB
Mathematica
178 lines
6.3 KiB
Mathematica
BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
|
|
;;1.7;BSDX;;Jun 01, 2013;Build 24
|
|
; Licensed under LGPL
|
|
;
|
|
; Change Log:
|
|
; July 10 2010:
|
|
; CANCLIN AND RBCLIN: Dates passed in FM format for i18n
|
|
;
|
|
Q
|
|
;
|
|
RBCLIND(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
|
|
;Entry point for debugging
|
|
;
|
|
;D DEBUG^%Serenji("RBCLIN^BSDX34(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
|
|
Q
|
|
;
|
|
RBERR ;
|
|
;Called from RBCLIN on error to set up header
|
|
K ^BSDXTMP($J)
|
|
S ^BSDXTMP($J,0)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus^I00010RESOURCEID"
|
|
S ^BSDXTMP($J,0)=^(0)_"^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)
|
|
D ERR(999)
|
|
Q
|
|
;
|
|
CANCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
|
|
;
|
|
;Return recordset of CANCELLED patient appointments
|
|
;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
|
|
;Used in generating cancellation letters for a clinic
|
|
;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
|
|
;v 1.3 BSDXBEG and BSDXEND are in fm format
|
|
;Called by BSDX CANCEL CLINIC LIST
|
|
N BSDXCAN
|
|
S BSDXCAN=1
|
|
D RBCLIN(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)
|
|
;
|
|
Q
|
|
;
|
|
RBCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
|
|
;
|
|
;Return recordset of rebooked patient appointments
|
|
;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
|
|
;Used in generating rebook letters for a clinic
|
|
;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
|
|
;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above
|
|
;Jul 11 2010 (smh):
|
|
;for i18n, pass BSDXBEG and BSDXEND in FM format.
|
|
;
|
|
S X="RBERR^BSDX34",@^%ZOSF("TRAP")
|
|
;
|
|
S BSDXY="^BSDXTMP("_$J_")"
|
|
N %DT,Y,BSDXJ,BSDXCID,BSDXCLN,BSDXSTRT,BSDXAID,BSDXNOD,BSDXLIST,BSDX,BSDY
|
|
;Convert beginning and ending dates
|
|
;TODO: Validation of date to make sure it's a right FM Date
|
|
S BSDXBEG=$P(BSDXBEG,".")
|
|
S BSDXEND=$P(BSDXEND,".")
|
|
S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
|
|
S BSDXEND=BSDXEND_".9999"
|
|
;
|
|
I BSDXCLST="" D RBERR Q
|
|
;
|
|
;
|
|
;If BSDXCLST is a list of resource NAMES, look up each name and convert to IEN
|
|
F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDX=$P(BSDXCLST,"|",BSDXJ) D S $P(BSDXCLST,"|",BSDXJ)=BSDY
|
|
. S BSDY=""
|
|
. I BSDX]"",$D(^BSDXRES(BSDX,0)) S BSDY=BSDX Q
|
|
. I BSDX]"",$D(^BSDXRES("B",BSDX)) S BSDY=$O(^BSDXRES("B",BSDX,0)) Q
|
|
. Q
|
|
;
|
|
;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)
|
|
;
|
|
S BSDXLIST=""
|
|
F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D:+BSDXCID
|
|
. 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))
|
|
. . . I $D(BSDXCAN) D Q
|
|
. . . . I $P(BSDXNOD,U,12) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Cancelled appt
|
|
. . . I $P(BSDXNOD,U,11) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Rebooked appt
|
|
D RBLETT(.BSDXY,BSDXLIST)
|
|
Q
|
|
;
|
|
RBLETTD(BSDXY,BSDXLIST) ;EP
|
|
;Entry point for debugging
|
|
;
|
|
;D DEBUG^%Serenji("RBLETT^BSDX34(.BSDXY,BSDXLIST)")
|
|
Q
|
|
;
|
|
RBLETT(BSDXY,BSDXLIST) ;EP
|
|
;Return recordset of patient appointments used in listing
|
|
;REBOOKED appointments for a list of appointmentIDs.
|
|
;Called by rpc BSDX REBOOK LIST
|
|
;BSDXLIST is a |-delimited list of BSDX APPOINTMENT iens (the last |-piece is null)
|
|
;
|
|
N BSDXI,BSDXIEN,BSDXNOD,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ,BSDX
|
|
S BSDXY="^BSDXTMP("_$J_")"
|
|
S BSDXI=0
|
|
S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus"
|
|
S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)
|
|
S X="ERROR^BSDX34",@^%ZOSF("TRAP")
|
|
;
|
|
;Iterate through BSDXLIST
|
|
S BSDXIEN=0
|
|
F BSDX=1:1:$L(BSDXLIST,"|")-1 S BSDXIEN=$P(BSDXLIST,"|",BSDX) D
|
|
. N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN,BSDXPAT
|
|
. N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
|
|
. N BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX
|
|
. N BSDXREBK
|
|
. S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
|
|
. Q:BSDXNOD=""
|
|
. S BSDXPAT=$P(BSDXNOD,U,5) ;PATIENT ien
|
|
. Q:'+BSDXPAT
|
|
. Q:'$D(^DPT(BSDXPAT))
|
|
. D PINFO(BSDXPAT)
|
|
. S Y=$P(BSDXNOD,U)
|
|
. Q:'+Y
|
|
. X ^DD("DD") S Y=$TR(Y,"@"," ")
|
|
. S BSDXAPT=Y ;Appointment date time
|
|
. S BSDXREBK=""
|
|
. S Y=$P(BSDXNOD,U,11)
|
|
. I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") S BSDXREBK=Y ;Rebook 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 BSDXTYPE="" ;Unused in this recordset
|
|
. S BSDXI=BSDXI+1
|
|
. S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXREBK_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_"^"_BSDXAPT_$C(30)
|
|
. Q
|
|
;
|
|
S BSDXI=BSDXI+1
|
|
S ^BSDXTMP($J,BSDXI)=$C(31)
|
|
Q
|
|
;
|
|
PINFO(BSDXPAT) ;
|
|
;Get patient info
|
|
N BSDXNOD
|
|
S BSDXNOD=$$PATINFO^BSDX27(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
|
|
Q
|
|
;
|
|
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
|