Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BSDX27

BSDX27.m

Go to the documentation of this file. 
  1. BSDX27 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
  1.  ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1. PADISPD(BSDXY,BSDXPAT) ;EP
  1.  ;Entry point for debugging
  1.  ;
  1.  ;D DEBUG^%Serenji("PADISP^BSDX27(.BSDXY,BSDXPAT)")
  1.  Q
  1.  ;
  1. PADISP(BSDXY,BSDXPAT) ;EP
  1.  ;Return recordset of patient appointments used in listing
  1.  ;a patient's appointments and generating patient letters.
  1.  ;Called by rpc BSDX PATIENT APPT DISPLAY
  1.  ;
  1.  N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ
  1.  N BSDXSTRT
  1.  N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
  1.  S BSDXY="^BSDXTMP("_$J_")"
  1.  S BSDXI=0
  1.  S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
  1.  S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
  1.  S X="ERROR^BSDX27",@^%ZOSF("TRAP")
  1.  ;Get patient info
  1.  ;
  1.  I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q
  1.  I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q
  1.  S BSDXNOD=$$PATINFO(BSDXPAT)
  1.  S BSDXNAM=$P(BSDXNOD,U) ;NAME
  1.  S BSDXSEX=$P(BSDXNOD,U,2) ;SEX
  1.  S BSDXDOB=$P(BSDXNOD,U,3) ;DOB
  1.  S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2)
  1.  S BSDXSTRE=$P(BSDXNOD,U,5) ;Street
  1.  S BSDXCITY=$P(BSDXNOD,U,6) ;City
  1.  S BSDXST=$P(BSDXNOD,U,7) ;State
  1.  S BSDXZIP=$P(BSDXNOD,U,8) ;zip
  1.  S BSDXPHON=$P(BSDXNOD,U,9) ;homephone
  1.  ;
  1.  ;Organize ^DPT(BSDXPAT,"S," nodes
  1.  ; into BSDXDPT(CLINIC,DATE)
  1.  ;
  1.  I $D(^DPT(BSDXPAT,"S")) S BSDXDT=0 F  S BSDXDT=$O(^DPT(BSDXPAT,"S",BSDXDT)) Q:'+BSDXDT  D
  1.  . S BSDXNOD=$G(^DPT(BSDXPAT,"S",BSDXDT,0))
  1.  . S BSDXCID=$P(BSDXNOD,U)
  1.  . Q:'+BSDXCID
  1.  . Q:'$D(^SC(BSDXCID,0))
  1.  . S BSDXDPT(BSDXCID,BSDXDT)=BSDXNOD
  1.  ;
  1.  ;$O Through ^BSDX("CPAT",
  1.  S BSDXIEN=0
  1.  I $D(^BSDXAPPT("CPAT",BSDXPAT)) F  S BSDXIEN=$O(^BSDXAPPT("CPAT",BSDXPAT,BSDXIEN)) Q:'BSDXIEN  D
  1.  . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN
  1.  . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
  1.  . Q:BSDXNOD=""
  1.  . Q:$P(BSDXNOD,U,12)]""  ;CANCELLED
  1.  . S Y=$P(BSDXNOD,U)
  1.  . Q:'+Y
  1.  . X ^DD("DD") S Y=$TR(Y,"@"," ")
  1.  . S BSDXAPT=Y ;Appointment date time
  1.  . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by
  1.  . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
  1.  . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made
  1.  . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
  1.  . S BSDXMADE=Y
  1.  . ;NOTE
  1.  . S BSDXNOT=""
  1.  . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F  S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ  D
  1.  . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))
  1.  . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
  1.  . . S BSDXNOT=BSDXNOT_BSDXLIN
  1.  . ;Resource
  1.  . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE
  1.  . Q:'+BSDXCID
  1.  . Q:'$D(^BSDXRES(BSDXCID,0))
  1.  . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node
  1.  . Q:BSDXCNOD=""
  1.  . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource
  1.  . S BSDX44=$P(BSDXCNOD,U,4) ;File 44 pointer
  1.  . ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from
  1.  . ;the BSDXDPT array and delete the BSDXDPT node
  1.  . S BSDXTYPE=""
  1.  . I +BSDX44,$D(BSDXDPT(BSDX44,$P(BSDXNOD,U))) D  ;BSDXNOD is the BSDX APPOINTMENT node
  1.  . . S BSDXDNOD=BSDXDPT(BSDX44,$P(BSDXNOD,U)) ;BSDXDNOD is a copy of the ^DPT(PAT,"S" node
  1.  . . S BSDXTYPE=$$STATUS(BSDXPAT,$P(BSDXNOD,U),BSDXDNOD) ;IHS/OIT/HMW 20050208 Added
  1.  . . K BSDXDPT(BSDX44,$P(BSDXNOD,U))
  1.  . S BSDXI=BSDXI+1
  1.  . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
  1.  . Q
  1.  ;
  1.  ;Go through remaining BSDXDPT( entries
  1.  I $D(BSDXDPT) S BSDX44=0 D
  1.  . F  S BSDX44=$O(BSDXDPT(BSDX44)) Q:'+BSDX44  S BSDXDT=0 D
  1.  . . F  S BSDXDT=$O(BSDXDPT(BSDX44,BSDXDT)) Q:'+BSDXDT  D
  1.  . . . S BSDXDNOD=BSDXDPT(BSDX44,BSDXDT)
  1.  . . . S Y=BSDXDT
  1.  . . . Q:'+Y
  1.  . . . X ^DD("DD") S Y=$TR(Y,"@"," ")
  1.  . . . S BSDXAPT=Y
  1.  . . . S BSDXTYPE=$$STATUS(BSDXPAT,BSDXDT,BSDXDNOD) ;IHS/OIT/HMW 20050208 Added
  1.  . . . S BSDXCLN=$P($G(^SC(BSDX44,0)),U)
  1.  . . . S BSDXCLRK=$P(BSDXDNOD,U,18)
  1.  . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
  1.  . . . S Y=$P(BSDXDNOD,U,19)
  1.  . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
  1.  . . . S BSDXMADE=Y
  1.  . . . S BSDXNOT=""
  1.  . . . S BSDXI=BSDXI+1
  1.  . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
  1.  . . . K BSDXDPT(BSDX44,BSDXDT)
  1.  ;
  1.  S BSDXI=BSDXI+1
  1.  S ^BSDXTMP($J,BSDXI)=$C(31)
  1.  Q
  1.  ;
  1. STATUS(PAT,DATE,NODE) ; returns appt status
  1.  ;IHS/OIT/HMW 20050208 Added from BSDDPA
  1.  NEW TYP
  1.  S TYP=$$APPTYP^BSDU2(PAT,DATE)    ;sched vs. walkin
  1.  I $P(NODE,U,2)["C" Q TYP_" - CANCELLED"
  1.  I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW"
  1.  I $$CO^BSDU2(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT"
  1.  I $$CI^BSDU2(PAT,+NODE,DATE) Q TYP_" - CHECKED IN"
  1.  Q TYP
  1.  ;
  1. ERROR ;
  1.  D ERR("RPMS Error")
  1.  Q
  1.  ;
  1. ERR(ERRNO) ;Error processing
  1.  S:'$D(BSDXI) BSDXI=999
  1.  I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
  1.  E  S BSDXERR=ERRNO
  1.  S BSDXI=BSDXI+1
  1.  S ^BSDXTMP($J,BSDXI)="^^^^^^^^^^^^^^^"_$C(30)
  1.  S BSDXI=BSDXI+1
  1.  S ^BSDXTMP($J,BSDXI)=$C(31)
  1.  Q
  1. PATINFO(BSDXPAT) ;EP
  1.  ;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien BSDXPAT
  1.  ;DOB is in external format
  1.  ;HRN depends on existence of DUZ(2)
  1.  ;
  1.  N BSDXNOD,BSDXNAM,BSDXSEX,BSDXDOB,BSDXHRN,BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
  1.  S BSDXNOD=^DPT(+BSDXPAT,0)
  1.  S BSDXNAM=$P(BSDXNOD,U) ;NAME
  1.  S BSDXSEX=$P(BSDXNOD,U,2)
  1.  S BSDXSEX=$S(BSDXSEX="F":"FEMALE",BSDXSEX="M":"MALE",1:"")
  1.  S Y=$P(BSDXNOD,U,3) I Y]""  X ^DD("DD") S Y=$TR(Y,"@"," ")
  1.  S BSDXDOB=Y ;DOB
  1.  S BSDXHRN=""
  1.  I $D(DUZ(2)) I DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN
  1.  ;
  1.  S BSDXNOD=$G(^DPT(+BSDXPAT,.11))
  1.  S (BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP)=""
  1.  I BSDXNOD]"" D
  1.  . S BSDXSTRT=$E($P(BSDXNOD,U),1,50) ;STREET
  1.  . S BSDXCITY=$P(BSDXNOD,U,4) ;CITY
  1.  . S BSDXST=$P(BSDXNOD,U,5) ;STATE
  1.  . I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2)
  1.  . S BSDXZIP=$P(BSDXNOD,U,6) ;ZIP
  1.  ;
  1.  S BSDXNOD=$G(^DPT(+BSDXPAT,.13)) ;PHONE
  1.  S BSDXPHON=$P(BSDXNOD,U)
  1.  ;
  1.  Q BSDXNAM_U_BSDXSEX_U_BSDXDOB_U_BSDXHRN_U_BSDXSTRT_U_BSDXCITY_U_BSDXST_U_BSDXZIP_U_BSDXPHON
  1.  ;
  1. CLDISPD(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
  1.  ;Entry point for debugging
  1.  ;
  1.  ;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
  1.  Q
  1.  ;
  1. CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND,BSDXWI) ;EP
  1.  ;Return recordset of patient appointments
  1.  ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
  1.  ;Used in listing a patient's appointments and generating patient letters.
  1.  ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)
  1.  ;BSDXBEG and BSDXEND are in external date form.
  1.  ;BSDXWI = return only appointments where the WALKIN field is yes
  1.  ;Called by BSDX CLINIC LETTERS
  1.  ;
  1.  N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT
  1.  N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN
  1.  N BSDXSTRT
  1.  N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
  1.  S BSDXY="^BSDXTMP("_$J_")"
  1.  K ^BSDXTMP($J)
  1.  S BSDXI=0
  1.  S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"
  1.  S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)
  1.  S X="ERROR^BSDX27",@^%ZOSF("TRAP")
  1.  ;
  1.  ;Convert beginning and ending dates
  1.  ;
  1.  S X=BSDXBEG,%DT="X" D ^%DT S BSDXBEG=$P(Y,"."),BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
  1.  I Y=-1 D ERR(BSDXI,0,"Routine: BSDX27, Error: Invalid Date") Q
  1.  S X=BSDXEND,%DT="X" D ^%DT S BSDXEND=$P(Y,"."),BSDXEND=BSDXEND_".9999"
  1.  I Y=-1 D ERR(BSDXI,0,"Routine: BSDX27, Error: Invalid Date") Q
  1.  I BSDXCLST="" D ERR(BSDXI,0,"Routine: BSDX27, Error: Null clinic list") Q
  1.  ;
  1.  ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)
  1.  ;
  1.  F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D
  1.  . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN=""
  1.  . S BSDXSTRT=BSDXBEG F  S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT  Q:BSDXSTRT>BSDXEND  D
  1.  . . S BSDXAID=0 F  S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID  D
  1.  . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))
  1.  . . . Q:BSDXNOD=""
  1.  . . . Q:$P(BSDXNOD,U,12)]""  ;CANCELLED
  1.  . . . I '$G(BSDXWI),$P(BSDXNOD,U,13)="y" Q  ;DO NOT ALLOW WALKIN
  1.  . . . I $G(BSDXWI),$P(BSDXNOD,U,13)'="y" Q  ;ONLY ALLOW WALKIN
  1.  . . . S Y=$P(BSDXNOD,U)
  1.  . . . Q:'+Y
  1.  . . . X ^DD("DD") S Y=$TR(Y,"@"," ")
  1.  . . . S BSDXAPT=Y ;Appointment date time
  1.  . . . ;
  1.  . . . ;NOTE
  1.  . . . S BSDXNOT=""
  1.  . . . I $D(^BSDXAPPT(BSDXAID,1,0)) S BSDXQ=0 F  S BSDXQ=$O(^BSDXAPPT(BSDXAID,1,BSDXQ)) Q:'+BSDXQ  D
  1.  . . . . S BSDXLIN=$G(^BSDXAPPT(BSDXAID,1,BSDXQ,0))
  1.  . . . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
  1.  . . . . S BSDXNOT=BSDXNOT_BSDXLIN
  1.  . . . ;
  1.  . . . S BSDXPAT=$P(BSDXNOD,U,5)
  1.  . . . S BSDXPNOD=$$PATINFO(BSDXPAT)
  1.  . . . S BSDXNAM=$P(BSDXPNOD,U) ;NAME
  1.  . . . S BSDXSEX=$P(BSDXPNOD,U,2) ;SEX
  1.  . . . S BSDXDOB=$P(BSDXPNOD,U,3) ;DOB
  1.  . . . S BSDXHRN=$P(BSDXPNOD,U,4) ;Health Record Number for location DUZ(2)
  1.  . . . S BSDXSTRE=$P(BSDXPNOD,U,5) ;Street
  1.  . . . S BSDXCITY=$P(BSDXPNOD,U,6) ;City
  1.  . . . S BSDXST=$P(BSDXPNOD,U,7) ;State
  1.  . . . S BSDXZIP=$P(BSDXPNOD,U,8) ;zip
  1.  . . . S BSDXPHON=$P(BSDXPNOD,U,9) ;homephone
  1.  . . . S BSDXTYPE="" ;Type/status doesn't exist for BSDX APPT clinics and it's not needed for clinic letters
  1.  . . . S BSDXCLRK=$P(BSDXNOD,U,8)
  1.  . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
  1.  . . . S Y=$P(BSDXNOD,U,9)
  1.  . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
  1.  . . . S BSDXMADE=Y
  1.  . . . S BSDXI=BSDXI+1
  1.  . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)
  1.  ;
  1.  S BSDXI=BSDXI+1
  1.  S ^BSDXTMP($J,BSDXI)=$C(31)
  1.  Q
  1.  ;
  1. CLDISPW(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
  1.  ;Return recordset of patient walk-in appointments
  1.  ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
  1.  ;Used in listing a patient's walk-in appointments and generating patient letters.
  1.  ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)
  1.  ;BSDXBEG and BSDXEND are in external date form.
  1.  ;Called by BSDX CLINIC LETTERS WALKIN
  1.  S:$G(U)="" U="^"
  1.  D CLDISP(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND,1)
  1.  Q