source: Scheduling/trunk/m/BSDX34.m@ 781

BSDX34  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/21/10 9:56pm
        ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
        ;
        ;
        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.)
        ;BSDXBEG and BSDXEND are in external date form.
        ;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.)
        ;BSDXBEG and BSDXEND are in external date form.
        ;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above
        ;
        ;
        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
        ;
        S X=BSDXBEG,%DT="XT" D ^%DT S BSDXBEG=$P(Y,"."),BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
        I Y=-1 D RBERR Q
        S X=BSDXEND,%DT="XT" D ^%DT S BSDXEND=$P(Y,"."),BSDXEND=BSDXEND_".9999"
        I Y=-1 D RBERR Q
        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