Changeset 961 for Scheduling


Ignore:
Timestamp:
Sep 28, 2010, 5:35:32 AM (14 years ago)
Author:
Sam Habiel
Message:

This fixes two bugs:

  1. If a patient has a Patient Cancelled appointment, scheduling the patient at the same time doesn't work anymore.
  2. MAKEBSDXAPI occasionally failed. Use of Old Fileman API not successful. New Fileman API seems to work better in 3986MAKE for filing data into patient subfile of appointment subfile of Hosp Location file.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • Scheduling/trunk/m/BSDXAPI.m

    r951 r961  
    1 BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm
    2         ;;1.4;BSDX;;Sep 07, 2010
    3         ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
    4         ;local mods (many) by WV/SMH
    5         ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
    6         ;
    7 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO)       ; Simplified PEP w/ parameters for $$MAKE - making appointment
    8         ; Call like this for DFN 23435 having an appointment at Hospital Location 33
    9         ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
    10         ; for Baby foxes hallucinations.
    11         ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
    12         S BSDR("PAT")=DFN       ;DFN
    13         S BSDR("CLN")=CLIN      ;Hosp Loc IEN
    14         S BSDR("TYP")=TYP       ;3 sched or 4 walkin
    15         S BSDR("ADT")=DATE      ;Appointment date in FM format
    16         S BSDR("LEN")=LEN       ;Appt len upto 240 (min)
    17         S BSDR("INFO")=INFO     ;Reason for appt - up to 150 char
    18         S BSDR("USR")=DUZ       ;Person who made appt - current user
    19         Q $$MAKE(.BSDR)
    20         ;
    21 MAKE(BSDR)      ;PEP; call to store appt made
    22         ;
    23         ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
    24         ;
    25         ; Input Array -
    26         ; BSDR("PAT") = ien of patient in file 2
    27         ; BSDR("CLN") = ien of clinic in file 44
    28         ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
    29         ; BSDR("ADT") = appointment date and time
    30         ; BSDR("LEN") = appointment length in minutes (5-120)
    31         ; BSDR("OI")  = reason for appt - up to 150 characters
    32         ; BSDR("USR") = user who made appt
    33         ;
    34         ;Output: error status and message
    35         ;   = 0 or null:  everything okay
    36         ;   = 1^message:  error and reason
    37         ;
    38         I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
    39         I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
    40         I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
    41         I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
    42         I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
    43         ;
    44         I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
    45         I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
    46         I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'="C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
    47         ;
    48         NEW DIC,DA,Y,X,DD,DO,DLAYGO
    49         ;
    50         I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)="C" D
    51         . ; "un-cancel" existing appt in file 2
    52         . N BSDXFDA,BSDXIENS,BSDXMSG
    53         . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
    54         . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
    55         . S BSDXFDA(2.98,BSDXIENS,"3")=""
    56         . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
    57         . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
    58         . S BSDXFDA(2.98,BSDXIENS,"14")=""
    59         . S BSDXFDA(2.98,BSDXIENS,"15")=""
    60         . S BSDXFDA(2.98,BSDXIENS,"16")=""
    61         . S BSDXFDA(2.98,BSDXIENS,"19")=""
    62         . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
    63         . D FILE^DIE("","BSDXFDA","BSDXMSG")
    64         . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
    65         E  D  I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") 
    66         . N BSDXFDA,BSDXIENS,BSDXMSG
    67         . S BSDXIENS="?+2,"_BSDR("PAT")_","
    68         . S BSDXIENS(2)=BSDR("ADT")
    69         . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
    70         . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
    71         . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
    72         . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
    73         . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
    74         ; add appt to file 44
    75         K DIC,DA,X,Y,DLAYGO,DD,DO
    76         I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
    77         I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D  I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
    78         . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
    79         . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
    80         . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
    81         ;
    82         K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
    83         S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
    84         S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
    85         S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
    86         S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
    87         D FILE^DICN
    88         ;
    89         ; call event driver
    90         NEW DFN,SDT,SDCL,SDDA,SDMODE
    91         S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
    92         S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    93         D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
    94         Q 0
    95         ;
    96 CHECKIN1(DFN,CLIN,APDATE)       ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
    97         ; Call like this for DFN 23435 checking in now at Hospital Location 33
    98         ; for appt at Dec 20, 2009 @ 10:11:59
    99         ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
    100         S BSDR("PAT")=DFN          ;DFN
    101         S BSDR("CLN")=CLIN         ;Hosp Loc IEN
    102         S BSDR("ADT")=APDATE       ;Appt Date
    103         S BSDR("CDT")=$$NOW^XLFDT  ;Check-in date defaults to now
    104         S BSDR("USR")=DUZ          ;Check-in user defaults to current
    105         Q $$CHECKIN(.BSDR)
    106         ;
    107 CHECKIN(BSDR)   ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
    108         ;
    109         ; Make call by using:  S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
    110         ;
    111         ; Input array -
    112         ;  BSDR("PAT") = ien of patient in file 2
    113         ;  BSDR("CLN") = ien of clinic in file 44
    114         ;  BSDR("ADT") = appt date/time
    115         ;  BSDR("CDT") = checkin date/time
    116         ;  BSDR("USR") = checkin user
    117         ;
    118         ; Output value -
    119         ;              = 0 means everything worked
    120         ;              = 1^message means error with reason message
    121         ;
    122         I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
    123         I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
    124         I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
    125         I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
    126         I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
    127         I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
    128         I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
    129         ;
    130         ; find ien for appt in file 44
    131         NEW IEN,DIE,DA,DR
    132         S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    133         I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
    134         ;
    135         ; remember before status
    136         NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
    137         S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
    138         S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
    139         D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
    140         ;
    141         ; set checkin
    142         S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
    143         S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
    144         S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
    145         D ^DIE
    146         ;
    147         ; set after status
    148         S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    149         S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
    150         D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
    151         ;
    152         ; call event driver
    153         D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
    154         Q 0
    155         ;
    156 CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO)        ; PEP w/ parameters for $$CANCEL - cancelling appointment
    157         ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
    158         ; cancellation initiated by patient ("PC" rather than clinic "C"),
    159         ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
    160         ; because foxes come out during bad weather.
    161         ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
    162         S BSDR("PAT")=DFN
    163         S BSDR("CLN")=CLIN
    164         S BSDR("TYP")=TYP
    165         S BSDR("ADT")=APDATE
    166         S BSDR("CDT")=$$NOW^XLFDT
    167         S BSDR("USR")=DUZ
    168         S BSDR("CR")=REASON
    169         S BSDR("NOT")=INFO
    170         Q $$CANCEL(.BSDR)
    171         ;
    172 CANCEL(BSDR)    ;PEP; called to cancel appt
    173         ;
    174         ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
    175         ;
    176         ; Input Array -
    177         ; BSDR("PAT") = ien of patient in file 2
    178         ; BSDR("CLN") = ien of clinic in file 44
    179         ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
    180         ; BSDR("ADT") = appointment date and time
    181         ; BSDR("CDT") = cancel date and time
    182         ; BSDR("USR") = user who canceled appt
    183         ; BSDR("CR")  = cancel reason - pointer to file 409.2
    184         ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
    185         ;
    186         ;Output: error status and message
    187         ;   = 0 or null:  everything okay
    188         ;   = 1^message:  error and reason
    189         ;
    190         I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
    191         I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
    192         I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
    193         I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
    194         I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
    195         I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
    196         I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
    197         I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
    198         I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
    199         ;
    200         NEW IEN,DIE,DA,DR
    201         S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    202         I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
    203         ;
    204         I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
    205         ;
    206         ; remember before status
    207         NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
    208         S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
    209         S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
    210         D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
    211         ;
    212         ; get user who made appt and date appt made from ^SC
    213         ;    because data in ^SC will be deleted
    214         NEW USER,DATE
    215         S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
    216         S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
    217         ;
    218         ; update file 2 info
    219         NEW DIE,DA,DR
    220         S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
    221         S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
    222         S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
    223         D ^DIE
    224         ;
    225         ; delete data in ^SC
    226         NEW DIK,DA
    227         S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
    228         S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
    229         D ^DIK
    230         ;
    231         ; call event driver
    232         D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
    233         Q 0
    234         ;
    235 CI(PAT,CLINIC,DATE,SDIEN)       ;PEP; -- returns 1 if appt already checked-in
    236         NEW X
    237         S X=$G(SDIEN)   ;ien sent in call
    238         I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
    239         S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
    240         Q $S(X:1,1:0)
    241         ;
    242 SCIEN(PAT,CLINIC,DATE)  ;PEP; returns ien for appt in ^SC
    243         NEW X,IEN
    244         S X=0 F  S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X  Q:$G(IEN)  D
    245         . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C"  ;cancelled
    246          . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
    247         Q $G(IEN)
    248         ;
    249 APPTYP(PAT,DATE)        ;PEP; -- returns type of appt (scheduled or walk-in)
    250         NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
    251         Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
    252         ;
    253 CO(PAT,CLINIC,DATE,SDIEN)       ;PEP; -- returns 1 if appt already checked-out
    254         NEW X
    255         S X=$G(SDIEN)   ;ien sent in call
    256         I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
    257         S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
    258         Q $S(X:1,1:0)
    259         ;
    260        
     1BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 9/28/10 12:36pm
     2 ;;1.4;BSDX;;Sep 07, 2010;Build 7
     3 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
     4 ;local mods (many) by WV/SMH
     5 ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
     6 ; Change History:
     7 ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
     8 ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
     9 ;
     10MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
     11 ; Call like this for DFN 23435 having an appointment at Hospital Location 33
     12 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
     13 ; for Baby foxes hallucinations.
     14 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
     15 S BSDR("PAT")=DFN       ;DFN
     16 S BSDR("CLN")=CLIN      ;Hosp Loc IEN
     17 S BSDR("TYP")=TYP       ;3 sched or 4 walkin
     18 S BSDR("ADT")=DATE      ;Appointment date in FM format
     19 S BSDR("LEN")=LEN       ;Appt len upto 240 (min)
     20 S BSDR("INFO")=INFO     ;Reason for appt - up to 150 char
     21 S BSDR("USR")=DUZ       ;Person who made appt - current user
     22 Q $$MAKE(.BSDR)
     23 ;
     24MAKE(BSDR) ;PEP; call to store appt made
     25 ;
     26 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
     27 ;
     28 ; Input Array -
     29 ; BSDR("PAT") = ien of patient in file 2
     30 ; BSDR("CLN") = ien of clinic in file 44
     31 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
     32 ; BSDR("ADT") = appointment date and time
     33 ; BSDR("LEN") = appointment length in minutes (5-120)
     34 ; BSDR("OI")  = reason for appt - up to 150 characters
     35 ; BSDR("USR") = user who made appt
     36 ;
     37 ;Output: error status and message
     38 ;   = 0 or null:  everything okay
     39 ;   = 1^message:  error and reason
     40 ;
     41 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
     42 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
     43 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
     44 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
     45 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     46 ;
     47 I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
     48 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
     49 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
     50 ;
     51 NEW DIC,DA,Y,X,DD,DO,DLAYGO
     52 ;
     53 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
     54 . ; "un-cancel" existing appt in file 2
     55 . N BSDXFDA,BSDXIENS,BSDXMSG
     56 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
     57 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
     58 . S BSDXFDA(2.98,BSDXIENS,"3")=""
     59 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
     60 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
     61 . S BSDXFDA(2.98,BSDXIENS,"14")=""
     62 . S BSDXFDA(2.98,BSDXIENS,"15")=""
     63 . S BSDXFDA(2.98,BSDXIENS,"16")=""
     64 . S BSDXFDA(2.98,BSDXIENS,"19")=""
     65 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
     66 . D FILE^DIE("","BSDXFDA","BSDXMSG")
     67 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
     68 E  D  I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") 
     69 . N BSDXFDA,BSDXIENS,BSDXMSG
     70 . S BSDXIENS="?+2,"_BSDR("PAT")_","
     71 . S BSDXIENS(2)=BSDR("ADT")
     72 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
     73 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
     74 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
     75 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
     76 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
     77 ; add appt to file 44
     78 K DIC,DA,X,Y,DLAYGO,DD,DO
     79 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
     80 I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D  I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
     81 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
     82 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
     83 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
     84 ;
     85 ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
     86 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
     87 ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
     88 ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
     89 ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
     90 ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
     91 ;D FILE^DICN
     92 ;
     93 N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
     94 N BSDXFDA
     95 S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
     96 S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
     97 S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
     98 S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
     99 S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
     100 N BSDXERR
     101 D UPDATE^DIE("","BSDXFDA","","BSDXERR")
     102 ;
     103 I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1)
     104 ;
     105 ; call event driver
     106 NEW DFN,SDT,SDCL,SDDA,SDMODE
     107 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
     108 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
     109 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
     110 Q 0
     111 ;
     112CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
     113 ; Call like this for DFN 23435 checking in now at Hospital Location 33
     114 ; for appt at Dec 20, 2009 @ 10:11:59
     115 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
     116 S BSDR("PAT")=DFN          ;DFN
     117 S BSDR("CLN")=CLIN         ;Hosp Loc IEN
     118 S BSDR("ADT")=APDATE       ;Appt Date
     119 S BSDR("CDT")=$$NOW^XLFDT  ;Check-in date defaults to now
     120 S BSDR("USR")=DUZ          ;Check-in user defaults to current
     121 Q $$CHECKIN(.BSDR)
     122 ;
     123CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
     124 ;
     125 ; Make call by using:  S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
     126 ;
     127 ; Input array -
     128 ;  BSDR("PAT") = ien of patient in file 2
     129 ;  BSDR("CLN") = ien of clinic in file 44
     130 ;  BSDR("ADT") = appt date/time
     131 ;  BSDR("CDT") = checkin date/time
     132 ;  BSDR("USR") = checkin user
     133 ;
     134 ; Output value -
     135 ;              = 0 means everything worked
     136 ;              = 1^message means error with reason message
     137 ;
     138 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
     139 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
     140 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
     141 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     142 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
     143 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
     144 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
     145 ;
     146 ; find ien for appt in file 44
     147 NEW IEN,DIE,DA,DR
     148 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
     149 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
     150 ;
     151 ; remember before status
     152 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
     153 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
     154 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
     155 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
     156 ;
     157 ; set checkin
     158 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
     159 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
     160 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
     161 D ^DIE
     162 ;
     163 ; set after status
     164 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
     165 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
     166 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
     167 ;
     168 ; call event driver
     169 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
     170 Q 0
     171 ;
     172CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
     173 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
     174 ; cancellation initiated by patient ("PC" rather than clinic "C"),
     175 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
     176 ; because foxes come out during bad weather.
     177 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
     178 S BSDR("PAT")=DFN
     179 S BSDR("CLN")=CLIN
     180 S BSDR("TYP")=TYP
     181 S BSDR("ADT")=APDATE
     182 S BSDR("CDT")=$$NOW^XLFDT
     183 S BSDR("USR")=DUZ
     184 S BSDR("CR")=REASON
     185 S BSDR("NOT")=INFO
     186 Q $$CANCEL(.BSDR)
     187 ;
     188CANCEL(BSDR) ;PEP; called to cancel appt
     189 ;
     190 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
     191 ;
     192 ; Input Array -
     193 ; BSDR("PAT") = ien of patient in file 2
     194 ; BSDR("CLN") = ien of clinic in file 44
     195 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
     196 ; BSDR("ADT") = appointment date and time
     197 ; BSDR("CDT") = cancel date and time
     198 ; BSDR("USR") = user who canceled appt
     199 ; BSDR("CR")  = cancel reason - pointer to file 409.2
     200 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
     201 ;
     202 ;Output: error status and message
     203 ;   = 0 or null:  everything okay
     204 ;   = 1^message:  error and reason
     205 ;
     206 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
     207 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
     208 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
     209 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
     210 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     211 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
     212 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
     213 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
     214 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
     215 ;
     216 NEW IEN,DIE,DA,DR
     217 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
     218 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
     219 ;
     220 I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
     221 ;
     222 ; remember before status
     223 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
     224 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
     225 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
     226 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
     227 ;
     228 ; get user who made appt and date appt made from ^SC
     229 ;    because data in ^SC will be deleted
     230 NEW USER,DATE
     231 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
     232 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
     233 ;
     234 ; update file 2 info
     235 NEW DIE,DA,DR
     236 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
     237 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
     238 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
     239 D ^DIE
     240 ;
     241 ; delete data in ^SC
     242 NEW DIK,DA
     243 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
     244 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
     245 D ^DIK
     246 ;
     247 ; call event driver
     248 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
     249 Q 0
     250 ;
     251CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
     252 NEW X
     253 S X=$G(SDIEN)   ;ien sent in call
     254 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
     255 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
     256 Q $S(X:1,1:0)
     257 ;
     258SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
     259 NEW X,IEN
     260 S X=0 F  S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X  Q:$G(IEN)  D
     261 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C"  ;cancelled
     262  . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
     263 Q $G(IEN)
     264 ;
     265APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
     266 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
     267 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
     268 ;
     269CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
     270 NEW X
     271 S X=$G(SDIEN)   ;ien sent in call
     272 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
     273 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
     274 Q $S(X:1,1:0)
     275 ;
Note: See TracChangeset for help on using the changeset viewer.