Ignore:
Timestamp:
Dec 12, 2010, 11:11:57 AM (13 years ago)
Author:
Sam Habiel
Message:

Updated routines version to 1.42

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:22pm
    2         ;;1.41;BSDX;;Sep 29, 2010
     1BSDX27   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 4:52pm
     2           ;;1.42;BSDX;;Dec 07, 2010
    33           ;
    44           ; 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           ;
     14PADISPD(BSDXY,BSDXPAT)   ;EP
     15           ;Entry point for debugging
     16           ;
     17           ;D DEBUG^%Serenji("PADISP^BSDX27(.BSDXY,BSDXPAT)")
     18           Q
     19           ;
     20PADISP(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           ;
     136STATUS(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           ;
     146ERROR     ;
     147           D ERR(BSDXI,"RPMS Error")
     148           Q
     149           ;
     150ERR(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
     159PATINFO(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           ;
    172188CLDISPD(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
    173         ;Entry point for debugging
    174         ;
    175         ;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
    176         Q
    177         ;
    178 CLDISP(BSDXY,BSDXCLST,BSDXBEG,BSDXEND)  ;EP
    179         ;
    180         ;Return recordset of patient appointments
    181         ;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 LETTERS
    186         ;
    187            ; July 10, 2010 -- to support i18n, we pass dates from client in
    188            ; locale-neutral Fileman format. No need to convert it.
    189         N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT
    190         N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN
    191         N BSDXSTRT
    192         N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
    193         S BSDXY="^BSDXTMP("_$J_")"
    194         K ^BSDXTMP($J)
    195         S BSDXI=0
    196         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 dates
    201         ;
    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") Q
    205         ;
    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) D
    209         . 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  D
    211         . . S BSDXAID=0 F  S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID  D
    212         . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))
    213         . . . Q:BSDXNOD=""
    214         . . . Q:$P(BSDXNOD,U,12)]""  ;CANCELLED
    215         . . . Q:$P(BSDXNOD,U,13)="y"  ;WALKIN
    216         . . . S Y=$P(BSDXNOD,U)
    217         . . . Q:'+Y
    218         . . . X ^DD("DD") S Y=$TR(Y,"@"," ")
    219         . . . S BSDXAPT=Y ;Appointment date time
    220         . . . ;
    221         . . . ;NOTE
    222         . . . S BSDXNOT=""
    223         . . . I $D(^BSDXAPPT(BSDXAID,1,0)) S BSDXQ=0 F  S BSDXQ=$O(^BSDXAPPT(BSDXAID,1,BSDXQ)) Q:'+BSDXQ  D
    224         . . . . S BSDXLIN=$G(^BSDXAPPT(BSDXAID,1,BSDXQ,0))
    225         . . . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
    226         . . . . S BSDXNOT=BSDXNOT_BSDXLIN
    227         . . . ;
    228         . . . S BSDXPAT=$P(BSDXNOD,U,5)
    229         . . . S BSDXPNOD=$$PATINFO(BSDXPAT)
    230         . . . S BSDXNAM=$P(BSDXPNOD,U) ;NAME
    231         . . . S BSDXSEX=$P(BSDXPNOD,U,2) ;SEX
    232         . . . S BSDXDOB=$P(BSDXPNOD,U,3) ;DOB
    233         . . . S BSDXHRN=$P(BSDXPNOD,U,4) ;Health Record Number for location DUZ(2)
    234         . . . S BSDXSTRE=$P(BSDXPNOD,U,5) ;Street
    235         . . . S BSDXCITY=$P(BSDXPNOD,U,6) ;City
    236         . . . S BSDXST=$P(BSDXPNOD,U,7) ;State
    237         . . . S BSDXZIP=$P(BSDXPNOD,U,8) ;zip
    238         . . . S BSDXPHON=$P(BSDXPNOD,U,9) ;homephone
    239         . . . S BSDXTYPE="" ;Type/status doesn't exist for BSDX APPT clinics and it's not needed for clinic letters
    240         . . . 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=Y
    245         . . . S BSDXI=BSDXI+1
    246         . . . 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+1
    249         S ^BSDXTMP($J,BSDXI)=$C(31)
    250         Q
     189           ;Entry point for debugging
     190           ;
     191           ;D DEBUG^%Serenji("CLDISP^BSDX27(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
     192           Q
     193           ;
     194CLDISP(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.