Changeset 968 for Scheduling/trunk/m


Ignore:
Timestamp:
Sep 29, 2010, 3:48:57 AM (14 years ago)
Author:
Sam Habiel
Message:

Bumped version up to 1.41

Location:
Scheduling/trunk/m
Files:
37 edited

Legend:

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

    r965 r968  
    11BSDX01  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:20am
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44SUINFOD(BSDXY,BSDXDUZ)  ;EP Debugging entry point
     
    3838        ;based on entries in BSDX RESOURCE USER file (Say this again for myself: Groups ONLY!!)
    3939        ;If BSDXDUZ=0 then returns all department names for current DUZ
    40     ;if not linked, always returned.
     40           ;if not linked, always returned.
    4141        ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
    4242        ;then ALL resource group names are returned regardless of whether any active resources
     
    6161        . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
    6262        . Q:'$D(^BSDXDEPT("AB",BSDXRES))  ; If not part of a group, quit ("AB" is the whole file index for the resource multiple in Group file)
    63     . ; Q:'$$INDIV2(BSDXRES)  ; If not in the same division as user, quit
     63           . ; Q:'$$INDIV2(BSDXRES)  ; If not in the same division as user, quit
    6464        . S BSDXRNOD=^BSDXRES(BSDXRES,0)
    6565        . ;QUIT if the resource is inactive
     
    120120        . S BSDXRNOD=^BSDXRES(BSDXRES,0)
    121121        . N BSDXSC S BSDXSC=$P(BSDXRNOD,U,4)  ; Hospital Location
    122     . ;Q:$P(BSDXRNOD,U,2)=1  ;Inactive resources not filtered
     122           . ;Q:$P(BSDXRNOD,U,2)=1  ;Inactive resources not filtered
    123123        . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
    124124        . ;I '$$INDIV(BSDXSC) QUIT  ; If not in division, quit
    125     . K BSDXRDAT
     125           . K BSDXRDAT
    126126        . F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX)
    127127        . S BSDXRDAT=BSDXRES_U_BSDXRDAT
     
    198198        . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
    199199        . Q:'$D(^BSDXDEPT("AB",BSDXRES))  ; Quit if Resource isn't part of any Group
    200     . ;Q:'$$INDIV2(BSDXRES)  ; Quit if Resource isn't in same division as user.
     200           . ;Q:'$$INDIV2(BSDXRES)  ; Quit if Resource isn't in same division as user.
    201201        . S BSDXRNOD=$G(^BSDXRES(BSDXRES,0))
    202202        . Q:BSDXRNOD=""
     
    223223        . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
    224224        . . Q:'$D(^BSDXRES(BSDXRESD,0))  ; Quit if zero node of resouce file is invalid
    225     . . ;Q:'$$INDIV2(BSDXRESD)  ; Quit if resource is not in the same division
     225           . . ;Q:'$$INDIV2(BSDXRESD)  ; Quit if resource is not in the same division
    226226        . . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
    227227        . . Q:BSDXRNOD=""
     
    257257        I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0
    258258        Q 1
    259 INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
    260     ; Input: BSDXSC - Hospital Location IEN
    261     ; Output: True or False
    262     I '+BSDXSC QUIT 1  ;If not tied to clinic, yes
    263     I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
    264     ; Jump to Division:Medical Center Division:Inst File Pointer for
    265     ; Institution IEN (and get its internal value)
    266     N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
    267     I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
    268     I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
    269     E  Q 0 ; Otherwise, no
    270     QUIT
    271 INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
    272     ; Input BSDXRES - BSDX RESOURCE IEN
    273     ; Output: True of False
    274     Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
    275 UnitTestINDIV
    276     W "Testing if they are the same",!
    277     S DUZ(2)=67
    278     I '$$INDIV(1) W "ERROR",!
    279     I '$$INDIV(2) W "ERROR",!
    280     W "Testing if Div not defined in 44, should be true",!
    281     I '$$INDIV(3) W "ERROR",!
    282     W "Testing empty string. Should be true",!
    283     I '$$INDIV("") W "ERROR",!
    284     W "Testing if they are different",!
    285     S DUZ(2)=899
    286     I $$INDIV(1) W "ERROR",!
    287     I $$INDIV(2) W "ERROR",!
    288     QUIT
    289 UnitTestINDIV2
    290     W "Testing if they are the same",!
    291     S DUZ(2)=69
    292     I $$INDIV2(22)'=0 W "ERROR",!
    293     I $$INDIV2(25)'=1 W "ERROR",!
    294     I $$INDIV2(26)'=1 W "ERROR",!
    295     I $$INDIV2(27)'=1 W "ERROR",!
    296     QUIT
     259INDIV(BSDXSC)   ; PEP - Is ^SC clinic in the same DUZ(2) as user?
     260           ; Input: BSDXSC - Hospital Location IEN
     261           ; Output: True or False
     262           I '+BSDXSC QUIT 1  ;If not tied to clinic, yes
     263           I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
     264           ; Jump to Division:Medical Center Division:Inst File Pointer for
     265           ; Institution IEN (and get its internal value)
     266           N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
     267           I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
     268           I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
     269           E  Q 0 ; Otherwise, no
     270           QUIT
     271INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
     272           ; Input BSDXRES - BSDX RESOURCE IEN
     273           ; Output: True of False
     274           Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
     275UnitTestINDIV   
     276           W "Testing if they are the same",!
     277           S DUZ(2)=67
     278           I '$$INDIV(1) W "ERROR",!
     279           I '$$INDIV(2) W "ERROR",!
     280           W "Testing if Div not defined in 44, should be true",!
     281           I '$$INDIV(3) W "ERROR",!
     282           W "Testing empty string. Should be true",!
     283           I '$$INDIV("") W "ERROR",!
     284           W "Testing if they are different",!
     285           S DUZ(2)=899
     286           I $$INDIV(1) W "ERROR",!
     287           I $$INDIV(2) W "ERROR",!
     288           QUIT
     289UnitTestINDIV2 
     290           W "Testing if they are the same",!
     291           S DUZ(2)=69
     292           I $$INDIV2(22)'=0 W "ERROR",!
     293           I $$INDIV2(25)'=1 W "ERROR",!
     294           I $$INDIV2(26)'=1 W "ERROR",!
     295           I $$INDIV2(27)'=1 W "ERROR",!
     296           QUIT
  • Scheduling/trunk/m/BSDX02.m

    r951 r968  
    11BSDX02  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:25pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33           ;
    44           ; Change Log
  • Scheduling/trunk/m/BSDX03.m

    r951 r968  
    11BSDX03  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX04.m

    r951 r968  
    11BSDX04  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 7/15/10 12:44pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33           ; Change Log:
    44           ; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates
  • Scheduling/trunk/m/BSDX05.m

    r951 r968  
    11BSDX05  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44           ; Change Log:
  • Scheduling/trunk/m/BSDX06.m

    r951 r968  
    11BSDX06  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 4:51pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33           ; Change Log:
    44           ; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
  • Scheduling/trunk/m/BSDX07.m

    r951 r968  
    11BSDX07  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 7/18/10 2:11pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33           ;
    44           ; Change Log:
  • Scheduling/trunk/m/BSDX08.m

    r951 r968  
    11BSDX08  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/15/10 8:21pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX09.m

    r951 r968  
    11BSDX09  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 8/16/10 4:28pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44           ; Change Log:
  • Scheduling/trunk/m/BSDX11.m

    r951 r968  
    11BSDX11  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44ENV0100 ;EP Version 1.0 Environment check
  • Scheduling/trunk/m/BSDX12.m

    r951 r968  
    11BSDX12  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:14pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33           ;
    44           ; Change Log:
  • Scheduling/trunk/m/BSDX13.m

    r951 r968  
    11BSDX13  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:17pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33           ;
    44           ; Change Log:
  • Scheduling/trunk/m/BSDX14.m

    r951 r968  
    11BSDX14  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX15.m

    r951 r968  
    11BSDX15  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX16.m

    r951 r968  
    11BSDX16  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX17.m

    r951 r968  
    11BSDX17  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX18.m

    r951 r968  
    11BSDX18  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX19.m

    r951 r968  
    11BSDX19  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX20.m

    r951 r968  
    11BSDX20  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX21.m

    r951 r968  
    11BSDX21  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/21/10 9:42pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX22.m

    r951 r968  
    11BSDX22  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX23.m

    r951 r968  
    11BSDX23  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX24.m

    r951 r968  
    11BSDX24  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX25.m

    r951 r968  
    11BSDX25  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX26.m

    r951 r968  
    11BSDX26  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX27.m

    r951 r968  
    11BSDX27  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:22pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33           ;
    44           ; Change Log: July 15, 2010
  • Scheduling/trunk/m/BSDX28.m

    r951 r968  
    11BSDX28  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:30pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44           ; Change Log:
  • Scheduling/trunk/m/BSDX29.m

    r951 r968  
    11BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33           ;
    44           ; Change Log:
  • Scheduling/trunk/m/BSDX2E.m

    r951 r968  
    11BSDX2E  ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/18/10 4:30pm]
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        S LINE="",$P(LINE,"*",81)=""
  • Scheduling/trunk/m/BSDX30.m

    r951 r968  
    11BSDX30  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [ 09/12/2007  1:54 PM ]
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX31.m

    r951 r968  
    11BSDX31  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX32.m

    r965 r968  
    11BSDX32  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:21am
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
     
    2020HOSPLOC(BSDXY)  ;EP
    2121        ;Called by BSDX HOSPITAL LOCATION
    22     ;Returns all hospital locations that are active
     22           ;Returns all hospital locations that are active
    2323        ;
    2424        N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA,BSDXSCOD
     
    3434        . Q:'+BSDXIEN>0
    3535        . Q:'$D(^SC(+BSDXIEN,0))
    36     . ;Q:'$$INDIV^BSDX01(+BSDXIEN)  ; if not in the same division, quit
     36           . ;Q:'$$INDIV^BSDX01(+BSDXIEN)  ; if not in the same division, quit
    3737        . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE
    3838        . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE
  • Scheduling/trunk/m/BSDX33.m

    r951 r968  
    11BSDX33  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33           ; Mods by WV/STAR
    44           ;
  • Scheduling/trunk/m/BSDX34.m

    r951 r968  
    11BSDX34  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:37pm
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33           ;
    44           ; Change Log:
  • Scheduling/trunk/m/BSDX35.m

    r951 r968  
    11BSDX35  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDXAPI.m

    r961 r968  
    1 BSDXAPI ; 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  ;
    10 MAKE1(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  ;
    24 MAKE(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  ;
    112 CHECKIN1(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  ;
    123 CHECKIN(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  ;
    172 CANCEL1(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  ;
    188 CANCEL(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  ;
    251 CI(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  ;
    258 SCIEN(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  ;
    265 APPTYP(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  ;
    269 CO(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  ;
     1BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 9/28/10 12:36pm
     2        ;;1.41;BSDX;;Sep 29, 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        ;
  • Scheduling/trunk/m/BSDXGPRV.m

    r951 r968  
    11BSDXGPRV        ; WV/SMH - WINDOWS SCHEDULING RPCS ; 9/7/10 7:59am
    2         ;;1.4;BSDX;;Sep 07, 2010
     2        ;;1.41;BSDX;;Sep 29, 2010
    33        ;
    44        ;
Note: See TracChangeset for help on using the changeset viewer.