Changeset 1041 for Scheduling/trunk/m/BSDX27.m
- Timestamp:
- Dec 12, 2010, 11:11:57 AM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX27.m
r968 r1041 1 BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:22pm2 ;;1.41;BSDX;;Sep 29, 20101 BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 4:52pm 2 ;;1.42;BSDX;;Dec 07, 2010 3 3 ; 4 4 ; Change Log: July 15, 2010 5 ; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP tag 6 ; 7 ; 8 Q 9 ; 10 PADISPD(BSDXY,BSDXPAT) ;EP 11 ;Entry point for debugging 12 ; 13 ;D DEBUG^%Serenji("PADISP^BSDX27(.BSDXY,BSDXPAT)") 14 Q 15 ; 16 PADISP(BSDXY,BSDXPAT) ;EP 17 ;Return recordset of patient appointments used in listing 18 ;a patient's appointments and generating patient letters. 19 ;Called by rpc BSDX PATIENT APPT DISPLAY 20 ; 21 N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ 22 N BSDXSTRT 23 N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON 24 S BSDXY="^BSDXTMP("_$J_")" 25 S BSDXI=0 26 S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus" 27 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30) 28 S X="ERROR^BSDX27",@^%ZOSF("TRAP") 29 ;Get patient info 30 ; 31 I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q 32 I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q 33 S BSDXNOD=$$PATINFO(BSDXPAT) 34 S BSDXNAM=$P(BSDXNOD,U) ;NAME 35 S BSDXSEX=$P(BSDXNOD,U,2) ;SEX 36 S BSDXDOB=$P(BSDXNOD,U,3) ;DOB 37 S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2) 38 S BSDXSTRE=$P(BSDXNOD,U,5) ;Street 39 S BSDXCITY=$P(BSDXNOD,U,6) ;City 40 S BSDXST=$P(BSDXNOD,U,7) ;State 41 S BSDXZIP=$P(BSDXNOD,U,8) ;zip 42 S BSDXPHON=$P(BSDXNOD,U,9) ;homephone 43 ; 44 ;Organize ^DPT(BSDXPAT,"S," nodes 45 ; into BSDXDPT(CLINIC,DATE) 46 ; 47 I $D(^DPT(BSDXPAT,"S")) S BSDXDT=0 F S BSDXDT=$O(^DPT(BSDXPAT,"S",BSDXDT)) Q:'+BSDXDT D 48 . S BSDXNOD=$G(^DPT(BSDXPAT,"S",BSDXDT,0)) 49 . S BSDXCID=$P(BSDXNOD,U) 50 . Q:'+BSDXCID 51 . Q:'$D(^SC(BSDXCID,0)) 52 . S BSDXDPT(BSDXCID,BSDXDT)=BSDXNOD 53 ; 54 ;$O Through ^BSDX("CPAT", 55 S BSDXIEN=0 56 I $D(^BSDXAPPT("CPAT",BSDXPAT)) F S BSDXIEN=$O(^BSDXAPPT("CPAT",BSDXPAT,BSDXIEN)) Q:'BSDXIEN D 57 . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN 58 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0)) 59 . Q:BSDXNOD="" 60 . Q:$P(BSDXNOD,U,12)]"" ;CANCELLED 61 . S Y=$P(BSDXNOD,U) 62 . Q:'+Y 63 . X ^DD("DD") S Y=$TR(Y,"@"," ") 64 . S BSDXAPT=Y ;Appointment date time 65 . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by 66 . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U) 67 . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made 68 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") 69 . S BSDXMADE=Y 70 . ;NOTE 71 . S BSDXNOT="" 72 . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ D 73 . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0)) 74 . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" " 75 . . S BSDXNOT=BSDXNOT_BSDXLIN 76 . ;Resource 77 . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE 78 . Q:'+BSDXCID 79 . Q:'$D(^BSDXRES(BSDXCID,0)) 80 . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node 81 . Q:BSDXCNOD="" 82 . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource 83 . S BSDX44=$P(BSDXCNOD,U,4) ;File 44 pointer 84 . ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from 85 . ;the BSDXDPT array and delete the BSDXDPT node 86 . S BSDXTYPE="" 87 . I +BSDX44,$D(BSDXDPT(BSDX44,$P(BSDXNOD,U))) D ;BSDXNOD is the BSDX APPOINTMENT node 88 . . S BSDXDNOD=BSDXDPT(BSDX44,$P(BSDXNOD,U)) ;BSDXDNOD is a copy of the ^DPT(PAT,"S" node 89 . . S BSDXTYPE=$$STATUS(BSDXPAT,$P(BSDXNOD,U),BSDXDNOD) ;IHS/OIT/HMW 20050208 Added 90 . . K BSDXDPT(BSDX44,$P(BSDXNOD,U)) 91 . S BSDXI=BSDXI+1 92 . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30) 93 . Q 94 ; 95 ;Go through remaining BSDXDPT( entries 96 I $D(BSDXDPT) S BSDX44=0 D 97 . F S BSDX44=$O(BSDXDPT(BSDX44)) Q:'+BSDX44 S BSDXDT=0 D 98 . . F S BSDXDT=$O(BSDXDPT(BSDX44,BSDXDT)) Q:'+BSDXDT D 99 . . . S BSDXDNOD=BSDXDPT(BSDX44,BSDXDT) 100 . . . S Y=BSDXDT 101 . . . Q:'+Y 102 . . . X ^DD("DD") S Y=$TR(Y,"@"," ") 103 . . . S BSDXAPT=Y 104 . . . S BSDXTYPE=$$STATUS(BSDXPAT,BSDXDT,BSDXDNOD) ;IHS/OIT/HMW 20050208 Added 105 . . . S BSDXCLN=$P($G(^SC(BSDX44,0)),U) 106 . . . S BSDXCLRK=$P(BSDXDNOD,U,18) 107 . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U) 108 . . . S Y=$P(BSDXDNOD,U,19) 109 . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") 110 . . . S BSDXMADE=Y 111 . . . S BSDXNOT="" 112 . . . S BSDXI=BSDXI+1 113 . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30) 114 . . . K BSDXDPT(BSDX44,BSDXDT) 115 ; 116 S BSDXI=BSDXI+1 117 S ^BSDXTMP($J,BSDXI)=$C(31) 118 Q 119 ; 120 STATUS(PAT,DATE,NODE) ; returns appt status 121 ;IHS/OIT/HMW 20050208 Added from BSDDPA 122 NEW TYP 123 S TYP=$$APPTYP^BSDXAPI(PAT,DATE) ;sched vs. walkin 124 I $P(NODE,U,2)["C" Q TYP_" - CANCELLED" 125 I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW" 126 I $$CO^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT" 127 I $$CI^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED IN" 128 Q TYP 129 ; 130 ERROR ; 131 D ERR(BSDXI,"RPMS Error") 132 Q 133 ; 134 ERR(BSDXI,ERRNO,MSG) ;Error processing 135 S:'$D(BSDXI) BSDXI=999 136 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError 137 E S BSDXERR=ERRNO 138 S BSDXI=BSDXI+1 139 S ^BSDXTMP($J,BSDXI)=MSG_"^^^^^^^^^^^^^^^"_$C(30) 140 S BSDXI=BSDXI+1 141 S ^BSDXTMP($J,BSDXI)=$C(31) 142 Q 143 PATINFO(BSDXPAT) ;EP 144 ;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien BSDXPAT 145 ;DOB is in external format 146 ;HRN depends on existence of DUZ(2) 147 ; 148 N BSDXNOD,BSDXNAM,BSDXSEX,BSDXDOB,BSDXHRN,BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON 149 S BSDXNOD=^DPT(+BSDXPAT,0) 150 S BSDXNAM=$P(BSDXNOD,U) ;NAME 151 S BSDXSEX=$P(BSDXNOD,U,2) 152 S BSDXSEX=$S(BSDXSEX="F":"FEMALE",BSDXSEX="M":"MALE",1:"") 153 S Y=$P(BSDXNOD,U,3) I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ") 154 S BSDXDOB=Y ;DOB 155 S BSDXHRN="" 156 I $D(DUZ(2)) I DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN 157 ; 158 S BSDXNOD=$G(^DPT(+BSDXPAT,.11)) 159 S (BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP)="" 160 I BSDXNOD]"" D 161 . S BSDXSTRT=$E($P(BSDXNOD,U),1,50) ;STREET 162 . S BSDXCITY=$P(BSDXNOD,U,4) ;CITY 163 . S BSDXST=$P(BSDXNOD,U,5) ;STATE 164 . I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2) 165 . S BSDXZIP=$P(BSDXNOD,U,6) ;ZIP 166 ; 167 S BSDXNOD=$G(^DPT(+BSDXPAT,.13)) ;PHONE 168 S BSDXPHON=$P(BSDXNOD,U) 169 ; 170 Q BSDXNAM_U_BSDXSEX_U_BSDXDOB_U_BSDXHRN_U_BSDXSTRT_U_BSDXCITY_U_BSDXST_U_BSDXZIP_U_BSDXPHON 171 ; 5 ; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP ta 6 ; v 1.42 - 3101208 - SMH 7 ; - Added check to skip cancelled appointments. Check was forgotten 8 ; in original code. 9 ; . N BSDXFLAGS S BSDXFLAGS=$P(BSDXNOD,U,2) ; No show and Cancel Flags 10 ; . Q:BSDXFLAGS["C" ; if appt is cancelled, quit 11 ; 12 Q 13 ; 14 PADISPD(BSDXY,BSDXPAT) ;EP 15 ;Entry point for debugging 16 ; 17 ;D DEBUG^%Serenji("PADISP^BSDX27(.BSDXY,BSDXPAT)") 18 Q 19 ; 20 PADISP(BSDXY,BSDXPAT) ;EP 21 ;Return recordset of patient appointments used in listing 22 ;a patient's appointments and generating patient letters. 23 ;Called by rpc BSDX PATIENT APPT DISPLAY 24 ; 25 ; Sam's Notes: 26 ; Relatively complex algorithm. 27 ; 1. First, loop through ^DPT(DA,"S", and get all appointments. 28 ; Exclude cancelled appts. Store in BSDXDPT array. 29 ; 2. Go through ^BSDXAPPT("CPAT", (patient index) . 30 ; Get the info from there and compar with BSDXDPT array. If 31 ; they are the same, get all info, and rm entry from BSDXDPT array. 32 ; 3. If there are any remaining entries in BSDXDPT (PIMS leftovers), 33 ; Get the data from file 2 and 44. 34 ; 35 N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ 36 N BSDXSTRT 37 N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON 38 S BSDXY="^BSDXTMP("_$J_")" 39 S BSDXI=0 40 S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus" 41 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30) 42 S X="ERROR^BSDX27",@^%ZOSF("TRAP") 43 ;Get patient info 44 ; 45 I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q 46 I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q 47 S BSDXNOD=$$PATINFO(BSDXPAT) 48 S BSDXNAM=$P(BSDXNOD,U) ;NAME 49 S BSDXSEX=$P(BSDXNOD,U,2) ;SEX 50 S BSDXDOB=$P(BSDXNOD,U,3) ;DOB 51 S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2) 52 S BSDXSTRE=$P(BSDXNOD,U,5) ;Street 53 S BSDXCITY=$P(BSDXNOD,U,6) ;City 54 S BSDXST=$P(BSDXNOD,U,7) ;State 55 S BSDXZIP=$P(BSDXNOD,U,8) ;zip 56 S BSDXPHON=$P(BSDXNOD,U,9) ;homephone 57 ; 58 ;Organize ^DPT(BSDXPAT,"S," nodes 59 ; into BSDXDPT(CLINIC,DATE) 60 ; 61 I $D(^DPT(BSDXPAT,"S")) S BSDXDT=0 F S BSDXDT=$O(^DPT(BSDXPAT,"S",BSDXDT)) Q:'+BSDXDT D 62 . S BSDXNOD=$G(^DPT(BSDXPAT,"S",BSDXDT,0)) 63 . S BSDXCID=$P(BSDXNOD,U) 64 . Q:'+BSDXCID 65 . Q:'$D(^SC(BSDXCID,0)) 66 . N BSDXFLAGS S BSDXFLAGS=$P(BSDXNOD,U,2) ; No show and Cancel Flags 67 . Q:BSDXFLAGS["C" ; if appt is cancelled, quit 68 . S BSDXDPT(BSDXCID,BSDXDT)=BSDXNOD 69 ; 70 ;$O Through ^BSDX("CPAT", 71 S BSDXIEN=0 72 I $D(^BSDXAPPT("CPAT",BSDXPAT)) F S BSDXIEN=$O(^BSDXAPPT("CPAT",BSDXPAT,BSDXIEN)) Q:'BSDXIEN D 73 . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN 74 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0)) 75 . Q:BSDXNOD="" 76 . Q:$P(BSDXNOD,U,12)]"" ;CANCELLED 77 . S Y=$P(BSDXNOD,U) 78 . Q:'+Y 79 . X ^DD("DD") S Y=$TR(Y,"@"," ") 80 . S BSDXAPT=Y ;Appointment date time 81 . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by 82 . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U) 83 . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made 84 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") 85 . S BSDXMADE=Y 86 . ;NOTE 87 . S BSDXNOT="" 88 . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ D 89 . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0)) 90 . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" " 91 . . S BSDXNOT=BSDXNOT_BSDXLIN 92 . ;Resource 93 . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE 94 . Q:'+BSDXCID 95 . Q:'$D(^BSDXRES(BSDXCID,0)) 96 . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node 97 . Q:BSDXCNOD="" 98 . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource 99 . S BSDX44=$P(BSDXCNOD,U,4) ;File 44 pointer 100 . ;If appt entry in ^DPT(PAT,"S" exists for this clinic, get the TYPE/STATUS info from 101 . ;the BSDXDPT array and delete the BSDXDPT node 102 . S BSDXTYPE="" 103 . I +BSDX44,$D(BSDXDPT(BSDX44,$P(BSDXNOD,U))) D ;BSDXNOD is the BSDX APPOINTMENT node 104 . . S BSDXDNOD=BSDXDPT(BSDX44,$P(BSDXNOD,U)) ;BSDXDNOD is a copy of the ^DPT(PAT,"S" node 105 . . S BSDXTYPE=$$STATUS(BSDXPAT,$P(BSDXNOD,U),BSDXDNOD) ;IHS/OIT/HMW 20050208 Added 106 . . K BSDXDPT(BSDX44,$P(BSDXNOD,U)) 107 . S BSDXI=BSDXI+1 108 . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30) 109 . Q 110 ; 111 ;Go through remaining BSDXDPT( entries 112 I $D(BSDXDPT) S BSDX44=0 D 113 . F S BSDX44=$O(BSDXDPT(BSDX44)) Q:'+BSDX44 S BSDXDT=0 D 114 . . F S BSDXDT=$O(BSDXDPT(BSDX44,BSDXDT)) Q:'+BSDXDT D 115 . . . S BSDXDNOD=BSDXDPT(BSDX44,BSDXDT) 116 . . . S Y=BSDXDT 117 . . . Q:'+Y 118 . . . X ^DD("DD") S Y=$TR(Y,"@"," ") 119 . . . S BSDXAPT=Y 120 . . . S BSDXTYPE=$$STATUS(BSDXPAT,BSDXDT,BSDXDNOD) ;IHS/OIT/HMW 20050208 Added 121 . . . S BSDXCLN=$P($G(^SC(BSDX44,0)),U) 122 . . . S BSDXCLRK=$P(BSDXDNOD,U,18) 123 . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U) 124 . . . S Y=$P(BSDXDNOD,U,19) 125 . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") 126 . . . S BSDXMADE=Y 127 . . . S BSDXNOT="" 128 . . . S BSDXI=BSDXI+1 129 . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30) 130 . . . K BSDXDPT(BSDX44,BSDXDT) 131 ; 132 S BSDXI=BSDXI+1 133 S ^BSDXTMP($J,BSDXI)=$C(31) 134 Q 135 ; 136 STATUS(PAT,DATE,NODE) ; returns appt status 137 ;IHS/OIT/HMW 20050208 Added from BSDDPA 138 NEW TYP 139 S TYP=$$APPTYP^BSDXAPI(PAT,DATE) ;sched vs. walkin 140 I $P(NODE,U,2)["C" Q TYP_" - CANCELLED" 141 I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW" 142 I $$CO^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT" 143 I $$CI^BSDXAPI(PAT,+NODE,DATE) Q TYP_" - CHECKED IN" 144 Q TYP 145 ; 146 ERROR ; 147 D ERR(BSDXI,"RPMS Error") 148 Q 149 ; 150 ERR(BSDXI,ERRNO,MSG) ;Error processing 151 S:'$D(BSDXI) BSDXI=999 152 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError 153 E S BSDXERR=ERRNO 154 S BSDXI=BSDXI+1 155 S ^BSDXTMP($J,BSDXI)=MSG_"^^^^^^^^^^^^^^^"_$C(30) 156 S BSDXI=BSDXI+1 157 S ^BSDXTMP($J,BSDXI)=$C(31) 158 Q 159 PATINFO(BSDXPAT) ;EP 160 ;Intrisic Function returns NAME^SEX^DOB^HRN^STREET^CITY^STATE^ZIP^PHONE for patient ien BSDXPAT 161 ;DOB is in external format 162 ;HRN depends on existence of DUZ(2) 163 ; 164 N BSDXNOD,BSDXNAM,BSDXSEX,BSDXDOB,BSDXHRN,BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON 165 S BSDXNOD=^DPT(+BSDXPAT,0) 166 S BSDXNAM=$P(BSDXNOD,U) ;NAME 167 S BSDXSEX=$P(BSDXNOD,U,2) 168 S BSDXSEX=$S(BSDXSEX="F":"FEMALE",BSDXSEX="M":"MALE",1:"") 169 S Y=$P(BSDXNOD,U,3) I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ") 170 S BSDXDOB=Y ;DOB 171 S BSDXHRN="" 172 I $D(DUZ(2)) I DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN 173 ; 174 S BSDXNOD=$G(^DPT(+BSDXPAT,.11)) 175 S (BSDXSTRT,BSDXCITY,BSDXST,BSDXZIP)="" 176 I BSDXNOD]"" D 177 . S BSDXSTRT=$E($P(BSDXNOD,U),1,50) ;STREET 178 . S BSDXCITY=$P(BSDXNOD,U,4) ;CITY 179 . S BSDXST=$P(BSDXNOD,U,5) ;STATE 180 . I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2) 181 . S BSDXZIP=$P(BSDXNOD,U,6) ;ZIP 182 ; 183 S BSDXNOD=$G(^DPT(+BSDXPAT,.13)) ;PHONE 184 S BSDXPHON=$P(BSDXNOD,U) 185 ; 186 Q BSDXNAM_U_BSDXSEX_U_BSDXDOB_U_BSDXHRN_U_BSDXSTRT_U_BSDXCITY_U_BSDXST_U_BSDXZIP_U_BSDXPHON 187 ; 172 188 CLDISPD(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP 173 ;Entry point for debugging174 ;175 ;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")176 Q177 ;178 CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP179 ;180 ;Return recordset of patient appointments181 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.182 ;Used in listing a patient's appointments and generating patient letters.183 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)184 ;BSDXBEG and BSDXEND are in external date form.185 ;Called by BSDX CLINIC LETTERS186 ;187 ; July 10, 2010 -- to support i18n, we pass dates from client in188 ; locale-neutral Fileman format. No need to convert it.189 N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT190 N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN191 N BSDXSTRT192 N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON193 S BSDXY="^BSDXTMP("_$J_")"194 K ^BSDXTMP($J)195 S BSDXI=0196 S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus"197 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30)198 S X="ERROR^BSDX27",@^%ZOSF("TRAP")199 ;200 ;Convert beginning and ending dates201 ;202 S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"203 S BSDXEND=BSDXEND_".9999"204 I BSDXCLST="" D ERR(BSDXI,0,"Routine: BSDX27, Error: Null clinic list") Q205 ;206 ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)207 ;208 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D209 . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN=""210 . S BSDXSTRT=BSDXBEG F S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT Q:BSDXSTRT>BSDXEND D211 . . S BSDXAID=0 F S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID D212 . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))213 . . . Q:BSDXNOD=""214 . . . Q:$P(BSDXNOD,U,12)]"" ;CANCELLED215 . . . Q:$P(BSDXNOD,U,13)="y" ;WALKIN216 . . . S Y=$P(BSDXNOD,U)217 . . . Q:'+Y218 . . . X ^DD("DD") S Y=$TR(Y,"@"," ")219 . . . S BSDXAPT=Y ;Appointment date time220 . . . ;221 . . . ;NOTE222 . . . S BSDXNOT=""223 . . . I $D(^BSDXAPPT(BSDXAID,1,0)) S BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAID,1,BSDXQ)) Q:'+BSDXQ D224 . . . . S BSDXLIN=$G(^BSDXAPPT(BSDXAID,1,BSDXQ,0))225 . . . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "226 . . . . S BSDXNOT=BSDXNOT_BSDXLIN227 . . . ;228 . . . S BSDXPAT=$P(BSDXNOD,U,5)229 . . . S BSDXPNOD=$$PATINFO(BSDXPAT)230 . . . S BSDXNAM=$P(BSDXPNOD,U) ;NAME231 . . . S BSDXSEX=$P(BSDXPNOD,U,2) ;SEX232 . . . S BSDXDOB=$P(BSDXPNOD,U,3) ;DOB233 . . . S BSDXHRN=$P(BSDXPNOD,U,4) ;Health Record Number for location DUZ(2)234 . . . S BSDXSTRE=$P(BSDXPNOD,U,5) ;Street235 . . . S BSDXCITY=$P(BSDXPNOD,U,6) ;City236 . . . S BSDXST=$P(BSDXPNOD,U,7) ;State237 . . . S BSDXZIP=$P(BSDXPNOD,U,8) ;zip238 . . . S BSDXPHON=$P(BSDXPNOD,U,9) ;homephone239 . . . S BSDXTYPE="" ;Type/status doesn't exist for BSDX APPT clinics and it's not needed for clinic letters240 . . . S BSDXCLRK=$P(BSDXNOD,U,8)241 . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)242 . . . S Y=$P(BSDXNOD,U,9)243 . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")244 . . . S BSDXMADE=Y245 . . . S BSDXI=BSDXI+1246 . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30)247 ;248 S BSDXI=BSDXI+1249 S ^BSDXTMP($J,BSDXI)=$C(31)250 Q189 ;Entry point for debugging 190 ; 191 ;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)") 192 Q 193 ; 194 CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP 195 ; 196 ;Return recordset of patient appointments 197 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST. 198 ;Used in listing a patient's appointments and generating patient letters. 199 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.) 200 ;BSDXBEG and BSDXEND are in external date form. 201 ;Called by BSDX CLINIC LETTERS 202 ; 203 ; July 10, 2010 -- to support i18n, we pass dates from client in 204 ; locale-neutral Fileman format. No need to convert it. 205 N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT 206 N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN 207 N BSDXSTRT 208 N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON 209 S BSDXY="^BSDXTMP("_$J_")" 210 K ^BSDXTMP($J) 211 S BSDXI=0 212 S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030ApptDate^T00030Clinic^T00030TypeStatus" 213 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE"_$C(30) 214 S X="ERROR^BSDX27",@^%ZOSF("TRAP") 215 ; 216 ;Convert beginning and ending dates 217 ; 218 S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999" 219 S BSDXEND=BSDXEND_".9999" 220 I BSDXCLST="" D ERR(BSDXI,0,"Routine: BSDX27, Error: Null clinic list") Q 221 ; 222 ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN) 223 ; 224 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D 225 . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN="" 226 . S BSDXSTRT=BSDXBEG F S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT Q:BSDXSTRT>BSDXEND D 227 . . S BSDXAID=0 F S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID D 228 . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0)) 229 . . . Q:BSDXNOD="" 230 . . . Q:$P(BSDXNOD,U,12)]"" ;CANCELLED 231 . . . Q:$P(BSDXNOD,U,13)="y" ;WALKIN 232 . . . S Y=$P(BSDXNOD,U) 233 . . . Q:'+Y 234 . . . X ^DD("DD") S Y=$TR(Y,"@"," ") 235 . . . S BSDXAPT=Y ;Appointment date time 236 . . . ; 237 . . . ;NOTE 238 . . . S BSDXNOT="" 239 . . . I $D(^BSDXAPPT(BSDXAID,1,0)) S BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAID,1,BSDXQ)) Q:'+BSDXQ D 240 . . . . S BSDXLIN=$G(^BSDXAPPT(BSDXAID,1,BSDXQ,0)) 241 . . . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" " 242 . . . . S BSDXNOT=BSDXNOT_BSDXLIN 243 . . . ; 244 . . . S BSDXPAT=$P(BSDXNOD,U,5) 245 . . . S BSDXPNOD=$$PATINFO(BSDXPAT) 246 . . . S BSDXNAM=$P(BSDXPNOD,U) ;NAME 247 . . . S BSDXSEX=$P(BSDXPNOD,U,2) ;SEX 248 . . . S BSDXDOB=$P(BSDXPNOD,U,3) ;DOB 249 . . . S BSDXHRN=$P(BSDXPNOD,U,4) ;Health Record Number for location DUZ(2) 250 . . . S BSDXSTRE=$P(BSDXPNOD,U,5) ;Street 251 . . . S BSDXCITY=$P(BSDXPNOD,U,6) ;City 252 . . . S BSDXST=$P(BSDXPNOD,U,7) ;State 253 . . . S BSDXZIP=$P(BSDXPNOD,U,8) ;zip 254 . . . S BSDXPHON=$P(BSDXPNOD,U,9) ;homephone 255 . . . S BSDXTYPE="" ;Type/status doesn't exist for BSDX APPT clinics and it's not needed for clinic letters 256 . . . S BSDXCLRK=$P(BSDXNOD,U,8) 257 . . . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U) 258 . . . S Y=$P(BSDXNOD,U,9) 259 . . . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") 260 . . . S BSDXMADE=Y 261 . . . S BSDXI=BSDXI+1 262 . . . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXAPT_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_$C(30) 263 ; 264 S BSDXI=BSDXI+1 265 S ^BSDXTMP($J,BSDXI)=$C(31) 266 Q
Note:
See TracChangeset
for help on using the changeset viewer.