Changeset 1041 for Scheduling


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

Updated routines version to 1.42

Location:
Scheduling/trunk/m
Files:
37 edited

Legend:

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

    r968 r1041  
    11BSDX01  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:20am
    2         ;;1.41;BSDX;;Sep 29, 2010
     2        ;;1.42;BSDX;;Dec 07, 2010
    33        ;
    44SUINFOD(BSDXY,BSDXDUZ)  ;EP Debugging entry point
  • Scheduling/trunk/m/BSDX02.m

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

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

    r968 r1041  
    11BSDX04  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 7/15/10 12:44pm
    2         ;;1.41;BSDX;;Sep 29, 2010
     2        ;;1.42;BSDX;;Dec 07, 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

    r968 r1041  
    1 BSDX05  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm
    2         ;;1.41;BSDX;;Sep 29, 2010
    3         ;
     1BSDX05   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 5:36pm
     2           ;;1.42;BSDX;;Dec 07, 2010
     3           ;
    44           ; Change Log:
    55           ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates
    6         ;
    7 APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES)         ;EP
    8         ;Called by BSDX APPT BLOCKS OVERLAP
    9            ; July 11 2010 - pass FM Dates for Start and End rather than US Dates
    10         ;(Duplicates old qryAppointmentBlocksOverlapB)
    11         ;BSDXRES is resource name
    12         ;
    13         ;Test lines:
    14         ;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES
    15         ;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT
    16         ;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES
    17         ;
    18         N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD
    19         K ^BSDXTMP($J)
    20         S BSDXERR=""
    21         S BSDXY="^BSDXTMP("_$J_")"
    22         S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME"_$C(30)
    23         D
    24         . S BSDXBS=0
    25         . S BSDXEND=BSDXEND+.9999 ;Go to end of day
    26         . S BSDXRESN=BSDXRES
    27         . Q:BSDXRESN=""
    28         . Q:'$D(^BSDXRES("B",BSDXRESN))
    29         . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
    30         . Q:'+BSDXRESD
    31         . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
    32         . D STRES(BSDXRESD,BSDXSTART,BSDXEND)
    33         . Q
    34         ;
    35         S BSDXI=$G(BSDXI)+1
    36         S ^BSDXTMP($J,BSDXI)=$C(31)
    37         Q
    38         ;
    39 STRES(BSDXRESD,BSDXSTART,BSDXEND)       ;
    40         ;$O THRU "ARSRC" XREF OF ^BSDXAPPT
    41         ;Start at the beginning of the day -- appts can't overlap days
    42         S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
    43         S BSDXI=0
    44         F  S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS  Q:BSDXS>BSDXEND  D
    45         . S BSDXAD=0 F  S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD  D STCOMM(BSDXAD) ;BSDXAD Is the AppointmentID
    46         . Q
    47         Q
    48         ;
    49 STCOMM(BSDXAD)  ;
    50         S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
    51         Q:'$D(^BSDXAPPT(BSDXAD,0))
    52         S BSDXNOD=^BSDXAPPT(BSDXAD,0)
    53         Q:$P(BSDXNOD,U,10)=1  ;NO-SHOW Flag
    54         Q:$P(BSDXNOD,U,12)]""  ;CANCELLED APPT
    55         Q:$P(BSDXNOD,U,13)="y"  ;WALKIN
    56         S BSDXNSTART=$P(BSDXNOD,U)
    57         S BSDXNEND=$P(BSDXNOD,U,2)
    58         I BSDXNEND'>BSDXSTART Q  ;End is less than start
    59         S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
    60         S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
    61         S BSDXI=BSDXI+1
    62         S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_$C(30)
    63         Q
     6           ; UJO/SMH - Dec 8 2010: In STCOMM, the logic was that an appointment
     7           ;  that was a walk-in didn't count towards slot calculations.
     8           ;  I checked PIMS, and Walk-ins do indeed count towards slot calculations.
     9           ;  Therefore, I commented this line out:
     10           ;    ;Q:$P(BSDXNOD,U,13)="y"  ;WALKIN
     11           ;
     12APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES)            ;EP
     13           ;Called by BSDX APPT BLOCKS OVERLAP
     14              ; July 11 2010 - pass FM Dates for Start and End rather than US Dates
     15           ;(Duplicates old qryAppointmentBlocksOverlapB)
     16           ;BSDXRES is resource name
     17           ;
     18           ;Test lines:
     19           ;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES
     20           ;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT
     21           ;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES
     22           ;
     23           N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD
     24           K ^BSDXTMP($J)
     25           S BSDXERR=""
     26           S BSDXY="^BSDXTMP("_$J_")"
     27           S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME"_$C(30)
     28           D
     29           . S BSDXBS=0
     30           . S BSDXEND=BSDXEND+.9999 ;Go to end of day
     31           . S BSDXRESN=BSDXRES
     32           . Q:BSDXRESN=""
     33           . Q:'$D(^BSDXRES("B",BSDXRESN))
     34           . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
     35           . Q:'+BSDXRESD
     36           . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
     37           . D STRES(BSDXRESD,BSDXSTART,BSDXEND)
     38           . Q
     39           ;
     40           S BSDXI=$G(BSDXI)+1
     41           S ^BSDXTMP($J,BSDXI)=$C(31)
     42           Q
     43           ;
     44STRES(BSDXRESD,BSDXSTART,BSDXEND)         ;
     45           ;$O THRU "ARSRC" XREF OF ^BSDXAPPT
     46           ;Start at the beginning of the day -- appts can't overlap days
     47           S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
     48           S BSDXI=0
     49           F  S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS  Q:BSDXS>BSDXEND  D
     50           . S BSDXAD=0 F  S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD  D STCOMM(BSDXAD) ;BSDXAD Is the AppointmentID
     51           . Q
     52           Q
     53           ;
     54STCOMM(BSDXAD)   ;
     55           S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
     56           Q:'$D(^BSDXAPPT(BSDXAD,0))
     57           S BSDXNOD=^BSDXAPPT(BSDXAD,0)
     58           Q:$P(BSDXNOD,U,10)=1  ;NO-SHOW Flag
     59           Q:$P(BSDXNOD,U,12)]""  ;CANCELLED APPT
     60           ; Q:$P(BSDXNOD,U,13)="y"  ;WALKIN -- new in V 1.42. See top comments.
     61           S BSDXNSTART=$P(BSDXNOD,U)
     62           S BSDXNEND=$P(BSDXNOD,U,2)
     63           I BSDXNEND'>BSDXSTART Q  ;End is less than start
     64           S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
     65           S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
     66           S BSDXI=BSDXI+1
     67           S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_$C(30)
     68           Q
  • Scheduling/trunk/m/BSDX06.m

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

    r998 r1041  
    1 BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS  ; 10/31/10 9:38am
    2         ;;1.42;BSDX;;Sep 29, 2010
    3         ;
    4         ; Change Log:
    5         ; UJO/SMH
    6         ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
    7     ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
    8     ;   thanks to Rick Marshall and Zach Gonzalez at Oroville.
    9         ; v1.42 Oct 30 2010 - Extensive refactoring.
    10     ;
    11     ; Error Reference:
    12     ; -1: Patient Record is locked. This means something is wrong!!!!
    13     ; -2: Start Time is not a valid Fileman date
    14     ; -3: End Time is not a valid Fileman date
    15     ; -4: End Time does not have time inside of it.
    16         ; -5: BSDXPATID is not numeric
    17     ; -6: Patient Does not exist in ^DPT
    18     ; -7: Resource Name does not exist in B index of BSDX RESOURCE
    19     ; -8: Resouce doesn't exist in ^BSDXRES
    20     ; -9: Couldn't add appointment to BSDX APPOINTMENT
    21     ; -10: Couldn't add appointment to files 2 and/or 44
    22     ; -100: Mumps Error
    23 
    24 APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)    ;EP
    25         ;Entry point for debugging
    26         D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
    27         Q
    28         ;
    29 UT ; Unit Tests
    30     N ZZZ
    31     ; Test for bad start date
    32     D APPADD(.ZZZ,2100123,3100123.3,2,"Dr Office",30,"Sam's Note",1)
    33     I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",!
    34     ; Test for bad end date
    35     D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1)
    36     I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",!
    37     ; Test for end date without time
    38     D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1)
    39     I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",!
    40     ; Test for mumps error
    41     S bsdxdie=1
    42     D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1)
    43     I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",!
    44     K bsdxdie
    45     ; Test for TRESTART
    46     s bsdxrestart=1
    47     D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
    48     I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",!
    49     k bsdxrestart
    50     ; Test for non-numeric patient
    51     D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1)
    52     I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",!
    53     ; Test for a non-existent patient
    54     D APPADD(.ZZZ,3100123.09,3100123.093,8989898989,"Dr Office",30,"Sam's Note",1)
    55     I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",!
    56     ; Test for a non-existent resource name
    57     D APPADD(.ZZZ,3100123.09,3100123.093,3,"lkajsflkjsadf",30,"Sam's Note",1)
    58     I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",!
    59     ; Test for corrupted resource
    60     ; Can't test for -8 since it requires DB corruption
    61     ; Test for inability to add appointment to BSDX Appointment
    62     ; Also requires something wrong in the DB
    63     ; Test for inability to add appointment to 2,44
    64     ; Test by creating a duplicate appointment
    65     D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
    66     D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
    67     I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",!
    68     ; Test for normality:
    69     D APPADD(.ZZZ,3110123.09,3110123.093,3,"Dr Office",30,"Sam's Note",1)
    70     ; Does Appt exist?
    71     N APPID S APPID=+$P(^BSDXTMP($J,1),U)
    72     I 'APPID W "Error Making Appt-1" QUIT
    73     I +^BSDXAPPT(APPID,0)'=3110123.09 W "Error Making Appt-2"
    74     I '$D(^DPT(3,"S",3110123.09)) W "Error Making Appt-3"
    75     I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4"
    76     QUIT
    77     ;
     1BSDX07  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS  ; 12/6/10 12:31pm
     2           ;;1.42;BSDX;;Dec 07, 2010
     3           ;
     4           ; Change Log:
     5           ; UJO/SMH
     6           ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
     7           ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
     8           ;   thanks to Rick Marshall and Zach Gonzalez at Oroville.
     9           ; v1.42 Oct 30 2010 - Extensive refactoring.
     10           ;
     11           ; Error Reference:
     12           ; -1: Patient Record is locked. This means something is wrong!!!!
     13           ; -2: Start Time is not a valid Fileman date
     14           ; -3: End Time is not a valid Fileman date
     15           ; -4: End Time does not have time inside of it.
     16           ; -5: BSDXPATID is not numeric
     17           ; -6: Patient Does not exist in ^DPT
     18           ; -7: Resource Name does not exist in B index of BSDX RESOURCE
     19           ; -8: Resouce doesn't exist in ^BSDXRES
     20           ; -9: Couldn't add appointment to BSDX APPOINTMENT
     21           ; -10: Couldn't add appointment to files 2 and/or 44
     22           ; -100: Mumps Error
     23       
     24APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)       ;EP
     25           ;Entry point for debugging
     26           D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
     27           Q
     28           ;
     29UT      ; Unit Tests
     30           N ZZZ
     31           ; Test for bad start date
     32           D APPADD(.ZZZ,2100123,3100123.3,2,"Dr Office",30,"Sam's Note",1)
     33           I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",!
     34           ; Test for bad end date
     35           D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1)
     36           I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",!
     37           ; Test for end date without time
     38           D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1)
     39           I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",!
     40           ; Test for mumps error
     41           S bsdxdie=1
     42           D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1)
     43           I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",!
     44           K bsdxdie
     45           ; Test for TRESTART
     46           s bsdxrestart=1
     47           D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
     48           I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",!
     49           k bsdxrestart
     50           ; Test for non-numeric patient
     51           D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1)
     52           I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",!
     53           ; Test for a non-existent patient
     54           D APPADD(.ZZZ,3100123.09,3100123.093,8989898989,"Dr Office",30,"Sam's Note",1)
     55           I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",!
     56           ; Test for a non-existent resource name
     57           D APPADD(.ZZZ,3100123.09,3100123.093,3,"lkajsflkjsadf",30,"Sam's Note",1)
     58           I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",!
     59           ; Test for corrupted resource
     60           ; Can't test for -8 since it requires DB corruption
     61           ; Test for inability to add appointment to BSDX Appointment
     62           ; Also requires something wrong in the DB
     63           ; Test for inability to add appointment to 2,44
     64           ; Test by creating a duplicate appointment
     65           D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
     66           D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
     67           I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",!
     68           ; Test for normality:
     69           D APPADD(.ZZZ,3110123.09,3110123.093,3,"Dr Office",30,"Sam's Note",1)
     70           ; Does Appt exist?
     71           N APPID S APPID=+$P(^BSDXTMP($J,1),U)
     72           I 'APPID W "Error Making Appt-1" QUIT
     73           I +^BSDXAPPT(APPID,0)'=3110123.09 W "Error Making Appt-2"
     74           I '$D(^DPT(3,"S",3110123.09)) W "Error Making Appt-3"
     75           I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4"
     76           QUIT
     77           ;
    7878APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)     ;EP
    79         ;Called by RPC: BSDX ADD NEW APPOINTMENT
    80         ;
    81     ;Add new appointment to 3 files
    82     ; - BSDX APPOINTMENT
    83     ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
    84     ; - Patient Appointment Subfile if Resource is linked to clinic
    85     ;
    86         ;Paramters:
    87     ;BSDXY: Global Return (RPC must be set to Global Array)
    88     ;BSDXSTART: FM Start Date
    89     ;BSDXEND: FM End Date
    90     ;BSDXPATID: Patient DFN
    91     ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
    92         ;BSDXLEN is the appointment duration in minutes
    93     ;BSDXNOTE is the Appiontment Note
    94         ;BSDXATID is used for 2 purposes:
    95         ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
    96         ; if BSDXATID = a number, then it is the access type id (used for rebooking)
    97         ;
    98         ;Return:
    99     ; ADO.net Recordset having fields:
    100         ; AppointmentID and ErrorNumber
    101         ;
    102         ;Test lines:
    103     ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
    104     ;
    105     ; Return Array; set Return and clear array
    106         S BSDXY=$NA(^BSDXTMP($J))
    107     K ^BSDXTMP($J)
    108     ; $ET
    109         N $ET S $ET="G ETRAP^BSDX07"
    110         ; Counter
    111         N BSDXI S BSDXI=0
    112         ; Lock BSDX node, only to synchronize access to the globals.
    113     ; It's not expected that the error will ever happen as no filing
    114     ; is supposed to take 5 seconds.
    115     L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
    116         ; Header Node
    117     S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00020ERRORID"_$C(30)
    118     ;Restartable Transaction; restore paramters when starting.
    119     ; (Params restored are what's passed here + BSDXI)
    120     TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07"
    121     ;
    122     ; Turn off SDAM APPT PROTOCOL BSDX Entries
    123         N BSDXNOEV
    124         S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
    125         ;
    126     ; Set Error Message to be empty
    127     N BSDXERR S BSDXERR=0
    128         ;
    129     ;;;test for error inside transaction. See if %ZTER works
    130     I $G(bsdxdie) S X=1/0
    131     ;;;test
    132     ;;;test for TRESTART
    133     I $G(bsdxrestart) K bsdxrestart TRESTART
    134     ;;;test
    135     ;
    136     ; -- Start and End Date Processing --
    137         ; If C# sends the dates with extra zeros, remove them
    138         S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
    139         ; Are the dates valid? Must be FM Dates > than 2010
    140     I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
    141     I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
    142     ; If Ending date doesn't have a time, this is an error
    143         I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
    144         ; If the Start Date is greater than the end date, swap dates
    145     N BSDXTMP
    146     I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
    147     ;
    148         ; Check if the patient exists:
    149     ; - DFN valid number?
    150     ; - Valid Patient in file 2?
    151     I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q
    152     I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
    153         ;
    154     ;Validate Resource entry
    155         I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
    156         N BSDXRESD ; Resource IEN
    157         S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
    158         N BSDXRNOD ; Resouce zero node
    159     S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
    160         I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
    161         ;
    162     ; Walk-in (Unscheduled) Appointment?
    163     N BSDXWKIN S BSDXWKIN=0
    164         I BSDXATID="WALKIN" S BSDXWKIN=1
    165     ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
    166         I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
    167         ;
    168     ; Done with all checks, let's make appointment in BSDX APPOINTMENT
    169         N BSDXAPPTID
    170     S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID)
    171         I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q
    172         I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
    173         ;
    174         ; Then Create Subfiles in 2/44 Appointment
    175         N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4)  ; Hosp Location IEN
    176     ; Only if we have a valid Hosp Loc can we make an appointment
    177         I +BSDXSCD,$D(^SC(BSDXSCD,0)) D  I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: ~MAKE^BSDAPI returned error code: "_BSDXERR) Q
    178         . N BSDXC
    179     . S BSDXC("PAT")=BSDXPATID
    180         . S BSDXC("CLN")=BSDXSCD
    181         . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
    182         . S:BSDXWKIN BSDXC("TYP")=4
    183         . S BSDXC("ADT")=BSDXSTART
    184         . S BSDXC("LEN")=BSDXLEN
    185         . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
    186         . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
    187         . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
    188         . S BSDXC("USR")=DUZ
    189         . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
    190         . Q:BSDXERR
    191         . ;Update RPMS Clinic availability
    192         . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)
    193         . Q
    194         ;
    195         ;Return Recordset
    196         TCOMMIT
    197         L -^BSDXAPPT(BSDXPATID)
    198         S BSDXI=BSDXI+1
    199         S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
    200         S BSDXI=BSDXI+1
    201         S ^BSDXTMP($J,BSDXI)=$C(31)
    202         Q
     79           ;Called by RPC: BSDX ADD NEW APPOINTMENT
     80           ;
     81           ;Add new appointment to 3 files
     82           ; - BSDX APPOINTMENT
     83           ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
     84           ; - Patient Appointment Subfile if Resource is linked to clinic
     85           ;
     86           ;Paramters:
     87           ;BSDXY: Global Return (RPC must be set to Global Array)
     88           ;BSDXSTART: FM Start Date
     89           ;BSDXEND: FM End Date
     90           ;BSDXPATID: Patient DFN
     91           ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
     92           ;BSDXLEN is the appointment duration in minutes
     93           ;BSDXNOTE is the Appiontment Note
     94           ;BSDXATID is used for 2 purposes:
     95           ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
     96           ; if BSDXATID = a number, then it is the access type id (used for rebooking)
     97           ;
     98           ;Return:
     99           ; ADO.net Recordset having fields:
     100           ; AppointmentID and ErrorNumber
     101           ;
     102           ;Test lines:
     103           ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
     104           ;
     105           ; Return Array; set Return and clear array
     106           S BSDXY=$NA(^BSDXTMP($J))
     107           K ^BSDXTMP($J)
     108           ; $ET
     109           N $ET S $ET="G ETRAP^BSDX07"
     110           ; Counter
     111           N BSDXI S BSDXI=0
     112           ; Lock BSDX node, only to synchronize access to the globals.
     113           ; It's not expected that the error will ever happen as no filing
     114           ; is supposed to take 5 seconds.
     115           L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
     116           ; Header Node
     117           S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
     118           ;Restartable Transaction; restore paramters when starting.
     119           ; (Params restored are what's passed here + BSDXI)
     120           TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07"
     121           ;
     122           ; Turn off SDAM APPT PROTOCOL BSDX Entries
     123           N BSDXNOEV
     124           S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
     125           ;
     126           ; Set Error Message to be empty
     127           N BSDXERR S BSDXERR=0
     128           ;
     129           ;;;test for error inside transaction. See if %ZTER works
     130           I $G(bsdxdie) S X=1/0
     131           ;;;test
     132           ;;;test for TRESTART
     133           I $G(bsdxrestart) K bsdxrestart TRESTART
     134           ;;;test
     135           ;
     136           ; -- Start and End Date Processing --
     137           ; If C# sends the dates with extra zeros, remove them
     138           S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
     139           ; Are the dates valid? Must be FM Dates > than 2010
     140           I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
     141           I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
     142           ; If Ending date doesn't have a time, this is an error
     143           I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
     144           ; If the Start Date is greater than the end date, swap dates
     145           N BSDXTMP
     146           I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
     147           ;
     148           ; Check if the patient exists:
     149           ; - DFN valid number?
     150           ; - Valid Patient in file 2?
     151           I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q
     152           I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
     153           ;
     154           ;Validate Resource entry
     155           I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
     156           N BSDXRESD ; Resource IEN
     157           S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
     158           N BSDXRNOD ; Resouce zero node
     159           S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
     160           I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
     161           ;
     162           ; Walk-in (Unscheduled) Appointment?
     163           N BSDXWKIN S BSDXWKIN=0
     164           I BSDXATID="WALKIN" S BSDXWKIN=1
     165           ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
     166           I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
     167           ;
     168           ; Done with all checks, let's make appointment in BSDX APPOINTMENT
     169           N BSDXAPPTID
     170           S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID)
     171           I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q
     172           I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
     173           ;
     174           ; Then Create Subfiles in 2/44 Appointment
     175           N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4)  ; Hosp Location IEN
     176           ; Only if we have a valid Hosp Loc can we make an appointment
     177           I +BSDXSCD,$D(^SC(BSDXSCD,0)) D  I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: ~MAKE^BSDAPI returned error code: "_BSDXERR) Q
     178           . N BSDXC
     179           . S BSDXC("PAT")=BSDXPATID
     180           . S BSDXC("CLN")=BSDXSCD
     181           . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
     182           . S:BSDXWKIN BSDXC("TYP")=4
     183           . S BSDXC("ADT")=BSDXSTART
     184           . S BSDXC("LEN")=BSDXLEN
     185           . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
     186           . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
     187           . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
     188           . S BSDXC("USR")=DUZ
     189           . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
     190           . Q:BSDXERR
     191           . ;Update RPMS Clinic availability
     192           . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)
     193           . Q
     194           ;
     195           ;Return Recordset
     196           TCOMMIT
     197           L -^BSDXAPPT(BSDXPATID)
     198           S BSDXI=BSDXI+1
     199           S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
     200           S BSDXI=BSDXI+1
     201           S ^BSDXTMP($J,BSDXI)=$C(31)
     202           Q
    203203BSDXDEL(BSDXAPPTID)     ;Deletes appointment BSDXAPPTID from BSDXAPPOINTMETN
    204         N DA,DIK
    205         S DIK="^BSDXAPPT(",DA=BSDXAPPTID
    206         D ^DIK
    207         Q
    208         ;
    209 STRIP(BSDXZ)    ;Replace control characters with spaces
    210         N BSDXI
    211         F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999)
    212         Q BSDXZ
    213         ;
    214 BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID)  ;ADD BSDX APPOINTMENT ENTRY
    215         ;Returns ien in BSDXAPPT or 0 if failed
    216         ;Create entry in BSDX APPOINTMENT
    217         N BSDXAPPTID
    218         S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
    219         S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
    220         S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
    221         S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
    222         S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
    223         S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
    224         S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
    225         S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
    226         N BSDXIEN,BSDXMSG
    227         D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
    228         S BSDXAPPTID=+$G(BSDXIEN(1))
    229         Q BSDXAPPTID
    230         ;
     204           N DA,DIK
     205           S DIK="^BSDXAPPT(",DA=BSDXAPPTID
     206           D ^DIK
     207           Q
     208           ;
     209STRIP(BSDXZ)       ;Replace control characters with spaces
     210           N BSDXI
     211           F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999)
     212           Q BSDXZ
     213           ;
     214BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID)   ;ADD BSDX APPOINTMENT ENTRY
     215           ;Returns ien in BSDXAPPT or 0 if failed
     216           ;Create entry in BSDX APPOINTMENT
     217           N BSDXAPPTID
     218           S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
     219           S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
     220           S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
     221           S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
     222           S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
     223           S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
     224           S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
     225           S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
     226           N BSDXIEN,BSDXMSG
     227           D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
     228           S BSDXAPPTID=+$G(BSDXIEN(1))
     229           Q BSDXAPPTID
     230           ;
    231231BSDXWP(BSDXAPPTID,BSDXNOTE)     ;
    232         ;Add WP field
    233         I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
    234         I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
    235         I $D(BSDXNOTE(.5)) D
    236         . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
    237         Q
    238         ;
     232           ;Add WP field
     233           I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
     234           I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
     235           I $D(BSDXNOTE(.5)) D
     236           . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
     237           Q
     238           ;
    239239ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA)     ;EP
    240         ;Called by BSDX ADD APPOINTMENT protocol
    241         ;BSDXSC=IEN of clinic in ^SC
    242         ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
    243         ;
    244         N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES
    245         Q:+$G(BSDXNOEV)
    246         I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
    247         E  I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
    248         Q:'+$G(BSDXRES)
    249         S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
    250         Q:BSDXNOD=""
    251         S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
    252         S BSDXWKIN=""
    253         S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
    254         S BSDXLEN=$P(BSDXNOD,U,2)
    255         Q:'+BSDXLEN
    256         S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
    257         S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
    258         Q:'+BSDXAPPTID
    259         S BSDXNOTE=$P(BSDXNOD,U,4)
    260         I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
    261         D ADDEVT3(BSDXRES)
    262         Q
    263         ;
    264 ADDEVT3(BSDXRES)        ;
    265         ;Call RaiseEvent to notify GUI clients
    266         N BSDXRESN
    267         S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
    268         Q:BSDXRESN=""
    269         S BSDXRESN=$P(BSDXRESN,"^")
    270         ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
    271         D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
    272         Q
    273         ;
    274 ERR(BSDXI,BSDXERR)      ;Error processing
    275         S BSDXI=BSDXI+1
    276         S BSDXERR=$TR(BSDXERR,"^","~")
    277         I $TL>0 TROLLBACK
    278         S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
    279         S BSDXI=BSDXI+1
    280         S ^BSDXTMP($J,BSDXI)=$C(31)
    281         L -^BSDXAPPT(BSDXPATID)
    282         Q
    283         ;
    284 ETRAP   ;EP Error trap entry
    285         N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
    286     ; Rollback, otherwise ^XTER will be empty from future rollback
    287     I $TL>0 TROLLBACK
    288     D ^%ZTER
    289     S $EC=""  ; Clear Error
    290         ; Log error message and send to client
    291     I '$D(BSDXI) N BSDXI S BSDXI=0
    292         D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
    293         Q
    294         ;
     240           ;Called by BSDX ADD APPOINTMENT protocol
     241           ;BSDXSC=IEN of clinic in ^SC
     242           ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
     243           ;
     244           N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES
     245           Q:+$G(BSDXNOEV)
     246           I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
     247           E  I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
     248           Q:'+$G(BSDXRES)
     249           S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
     250           Q:BSDXNOD=""
     251           S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
     252           S BSDXWKIN=""
     253           S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
     254           S BSDXLEN=$P(BSDXNOD,U,2)
     255           Q:'+BSDXLEN
     256           S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
     257           S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
     258           Q:'+BSDXAPPTID
     259           S BSDXNOTE=$P(BSDXNOD,U,4)
     260           I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
     261           D ADDEVT3(BSDXRES)
     262           Q
     263           ;
     264ADDEVT3(BSDXRES)           ;
     265           ;Call RaiseEvent to notify GUI clients
     266           N BSDXRESN
     267           S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
     268           Q:BSDXRESN=""
     269           S BSDXRESN=$P(BSDXRESN,"^")
     270           ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
     271           D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
     272           Q
     273           ;
     274ERR(BSDXI,BSDXERR)       ;Error processing
     275           S BSDXI=BSDXI+1
     276           S BSDXERR=$TR(BSDXERR,"^","~")
     277           I $TL>0 TROLLBACK
     278           S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
     279           S BSDXI=BSDXI+1
     280           S ^BSDXTMP($J,BSDXI)=$C(31)
     281           L -^BSDXAPPT(BSDXPATID)
     282           Q
     283           ;
     284ETRAP     ;EP Error trap entry
     285           N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
     286           ; Rollback, otherwise ^XTER will be empty from future rollback
     287           I $TL>0 TROLLBACK
     288           D ^%ZTER
     289           S $EC=""  ; Clear Error
     290           ; Log error message and send to client
     291           I '$D(BSDXI) N BSDXI S BSDXI=0
     292           D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
     293           Q
     294           ;
    295295DAY     ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
    296         ;
     296           ;
    297297DOW     S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
    298         F %=%:-1:281 S Y=%#4=1+1+Y
    299         S Y=$E(X,6,7)+Y#7
    300         Q
    301         ;
    302 AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)       ;Update RPMS Clinic availability
    303         ;SEE SDM1
    304         N Y,DFN
    305         N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG
    306         N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I
    307         S Y=BSDXSCD,DFN=BSDXPATID
    308         S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y
    309         ;Determine maximum days for scheduling
    310         S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365
    311         S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))
    312         S SDDATE=BSDXSTART
    313         S SDSDATE=SDDATE,SDDATE=SDDATE\1
    314 1       ;L  Q:$D(SDXXX)  S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0  S SC=+SC
    315         Q:$D(SDXXX)  S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0  S SC=+SC
    316         S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)
    317         S X2=SDEDT D C^%DTC S SDEDT=X
    318         S Y=BSDXSTART
     298           F %=%:-1:281 S Y=%#4=1+1+Y
     299           S Y=$E(X,6,7)+Y#7
     300           Q
     301           ;
     302AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)         ;Update RPMS Clinic availability
     303           ;SEE SDM1
     304           N Y,DFN
     305           N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG
     306           N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I
     307           S Y=BSDXSCD,DFN=BSDXPATID
     308           S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y
     309           ;Determine maximum days for scheduling
     310           S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365
     311           S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))
     312           S SDDATE=BSDXSTART
     313           S SDSDATE=SDDATE,SDDATE=SDDATE\1
     3141         ;L  Q:$D(SDXXX)  S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0  S SC=+SC
     315           Q:$D(SDXXX)  S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0  S SC=+SC
     316           S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)
     317           S X2=SDEDT D C^%DTC S SDEDT=X
     318           S Y=BSDXSTART
    319319EN1     S (X,SD)=Y,SM=0 D DOW
    320 S       I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0  Q:^(SS,1)=""  S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".")
    321         S S=BSDXLEN
    322         ;Check if BSDXLEN evenly divisible by appointment length
    323         S RPMSL=$P(SL,U)
    324         I BSDXLEN<RPMSL S BSDXLEN=RPMSL
    325         I BSDXLEN#RPMSL'=0 D
    326         . S BSDXINC=BSDXLEN\RPMSL
    327         . S BSDXINC=BSDXINC+1
    328         . S BSDXLEN=RPMSL*BSDXINC
    329         S SL=S_U_$P(SL,U,2,99)
    330 SC      S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
    331         L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC
    332         S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)
    333         S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST
    334         I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q
    335         I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7
    336         ;
    337 SP      I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP
    338         S SDNOT=1
    339         S ABORT=0
    340         F I=ST+ST:SDDIF:SS-SDDIF D  Q:ABORT
    341         . S ST=$E(S,I+1) S:ST="" ST=" "
    342         . S Y=$E(STR,$F(STR,ST)-2)
    343         . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q
    344         . I Y="" S ABORT=1 Q
    345         . S:Y'?1NL&(SM<6) SM=6 S ST=$E(S,I+2,999) S:ST="" ST=" " S S=$E(S,1,I)_Y_ST
    346         . Q
    347         S ^SC(SC,"ST",$P(SD,"."),1)=S
    348         L -^SC(SC,"ST",$P(SD,"."),1)
    349         Q
     320S         I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0  Q:^(SS,1)=""  S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".")
     321           S S=BSDXLEN
     322           ;Check if BSDXLEN evenly divisible by appointment length
     323           S RPMSL=$P(SL,U)
     324           I BSDXLEN<RPMSL S BSDXLEN=RPMSL
     325           I BSDXLEN#RPMSL'=0 D
     326           . S BSDXINC=BSDXLEN\RPMSL
     327           . S BSDXINC=BSDXINC+1
     328           . S BSDXLEN=RPMSL*BSDXINC
     329           S SL=S_U_$P(SL,U,2,99)
     330SC       S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
     331           L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC
     332           S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)
     333           S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST
     334           I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q
     335           I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7
     336           ;
     337SP       I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP
     338           S SDNOT=1
     339           S ABORT=0
     340           F I=ST+ST:SDDIF:SS-SDDIF D  Q:ABORT
     341           . S ST=$E(S,I+1) S:ST="" ST=" "
     342           . S Y=$E(STR,$F(STR,ST)-2)
     343           . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q
     344           . I Y="" S ABORT=1 Q
     345           . S:Y'?1NL&(SM<6) SM=6 S ST=$E(S,I+2,999) S:ST="" ST=" " S S=$E(S,1,I)_Y_ST
     346           . Q
     347           S ^SC(SC,"ST",$P(SD,"."),1)=S
     348           L -^SC(SC,"ST",$P(SD,"."),1)
     349           Q
  • Scheduling/trunk/m/BSDX08.m

    r1007 r1041  
    1 BSDX08  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 11/16/10 7:12am
    2         ;;1.42;BSDX;;Sep 29, 2010
    3     ;
    4     ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
    5     ;
    6     ; Change History
    7     ; 3101022 UJO/SMH v1.42
    8     ;  - Transaction now restartable. Thanks to
    9     ;   --> Zach Gonzalez and Rick Marshall for fix.
    10     ;  - Extra TROLLBACK in Lock Statement when lock fails.
    11     ;   --> Removed--Rollback is already in ERR tag.
    12     ;  - Added new statements to old SD code in AVUPDT to obviate
    13     ;   --> need to restore variables in transaction
    14     ;  - Refactored this chunk of code. Don't really know whether it
    15     ;   --> worked in the first place. Waiting for bug report to know.
    16     ;  - Refactored all of APPDEL.
    17     ;
    18     ; Error Reference:
    19     ;  -1~BSDX08: Appt record is locked. Please contact technical support.
    20     ;  -2~BSDX08: Invalid Appointment ID
     1BSDX08  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:35pm
     2        ;;1.42;BSDX;;Dec 07, 2010
     3           ;
     4           ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
     5           ;
     6           ; Change History
     7           ; 3101022 UJO/SMH v1.42
     8           ;  - Transaction now restartable. Thanks to
     9           ;   --> Zach Gonzalez and Rick Marshall for fix.
     10           ;  - Extra TROLLBACK in Lock Statement when lock fails.
     11           ;   --> Removed--Rollback is already in ERR tag.
     12           ;  - Added new statements to old SD code in AVUPDT to obviate
     13           ;   --> need to restore variables in transaction
     14           ;  - Refactored this chunk of code. Don't really know whether it
     15           ;   --> worked in the first place. Waiting for bug report to know.
     16           ;  - Refactored all of APPDEL.
     17           ;
     18           ; Error Reference:
     19           ;  -1~BSDX08: Appt record is locked. Please contact technical support.
     20           ;  -2~BSDX08: Invalid Appointment ID
    2121        ;  -3~BSDX08: Invalid Appointment ID
    22     ;  -4~BSDX08: Cancelled appointment does not have a Resouce ID 
    23     ;  -5~BSDX08: Resouce ID does not exist in BSDX RESOURCE
    24     ;  -6~BSDX08: Invalid Hosp Location stored in Database
    25     ;  -7~BSDX08: Patient does not have an appointment in PIMS Clinic
    26     ;  -8^BSDX08: Unable to find associated PIMS appointment for this patient
    27     ;  -9^BSDX08: BSDXAPI returned an error: (error)
    28     ;  -100~BSDX08 Error: (Mumps Error)
     22           ;  -4~BSDX08: Cancelled appointment does not have a Resouce ID 
     23           ;  -5~BSDX08: Resouce ID does not exist in BSDX RESOURCE
     24           ;  -6~BSDX08: Invalid Hosp Location stored in Database
     25           ;  -7~BSDX08: Patient does not have an appointment in PIMS Clinic
     26           ;  -8^BSDX08: Unable to find associated PIMS appointment for this patient
     27           ;  -9^BSDX08: BSDXAPI returned an error: (error)
     28           ;  -100~BSDX08 Error: (Mumps Error)
    2929        ;
    3030APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
     
    3333        Q
    3434        ;
    35 UT ; Unit Tests
    36     ; Test 1: Make normal appointment and cancel it. See if every thing works
    37     N ZZZ
    38     D APPADD^BSDX07(.ZZZ,3110123.2,3110123.3,4,"Dr Office",10,"Sam's Note",1)
    39     S APPID=+$P(^BSDXTMP($J,1),U)
    40     D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
    41     I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1"
    42     I $O(^SC(2,"S",3110123.2,1,0))]"" W "Error in Cancellation-2"
    43     I $P(^DPT(4,"S",3110123.2,0),U,2)'="PC" W "Error in Cancellation-3"
    44     I ^DPT(4,"S",3110123.2,"R")'="Sam's Cancel Note" W "Error in Cancellation-4"
    45     ;
    46     ; Test 2: Check for -1
    47     ; Make appt
    48     D APPADD^BSDX07(.ZZZ,3110125.2,3110125.3,4,"Dr Office",10,"Sam's Note",1)
    49     ; Lock the node in another job
    50     S APPID=+$P(^BSDXTMP($J,1),U)
    51     ; W "Lock ^BSDXAPPT("_APPID_") in another session. You have 10 seconds." H 10
    52     D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
    53     ;
    54     ; Test 3: Check for -100
    55     S bsdxdie=1
    56     D APPADD^BSDX07(.ZZZ,3110126.2,3110126.3,4,"Dr Office",10,"Sam's Note",1)
    57     S APPID=+$P(^BSDXTMP($J,1),U)
    58     D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
    59     I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100",!
    60     K bsdxdie
    61     ;
    62     ; Test 4: Restartable transaction
    63     S bsdxrestart=1
    64     D APPADD^BSDX07(.ZZZ,3110128.2,3110128.3,4,"Dr Office",10,"Sam's Note",1)
    65     S APPID=+$P(^BSDXTMP($J,1),U)
    66     D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
    67     I $P(^DPT(4,"S",3110128.2,0),U,2)'="PC" W "Error in Restartable Transaction",!
    68     ;
    69     ; Test 5: for invalid Appointment ID (-2 and -3)
    70     D APPDEL^BSDX08(.ZZZ,0,"PC",1,"Reasons")
    71     I $P(^BSDXTMP($J,1),"~")'=-2 W "Error in -2",!
    72     D APPDEL^BSDX08(.ZZZ,999999,"PC",1,"Reasons")
    73     I $P(^BSDXTMP($J,1),"~")'=-3 W "Error in -3",!
    74     QUIT
    75     ; Lock the node in another job for testing.
    76 UTL(APPID) L +^BSDXAPPT(APPID) HANG 10 QUIT
    77     ;
     35UT      ; Unit Tests
     36           ; Test 1: Make normal appointment and cancel it. See if every thing works
     37           N ZZZ
     38           D APPADD^BSDX07(.ZZZ,3110123.2,3110123.3,4,"Dr Office",10,"Sam's Note",1)
     39           S APPID=+$P(^BSDXTMP($J,1),U)
     40           D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
     41           I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1"
     42           I $O(^SC(2,"S",3110123.2,1,0))]"" W "Error in Cancellation-2"
     43           I $P(^DPT(4,"S",3110123.2,0),U,2)'="PC" W "Error in Cancellation-3"
     44           I ^DPT(4,"S",3110123.2,"R")'="Sam's Cancel Note" W "Error in Cancellation-4"
     45           ;
     46           ; Test 2: Check for -1
     47           ; Make appt
     48           D APPADD^BSDX07(.ZZZ,3110125.2,3110125.3,4,"Dr Office",10,"Sam's Note",1)
     49           ; Lock the node in another job
     50           S APPID=+$P(^BSDXTMP($J,1),U)
     51           ; W "Lock ^BSDXAPPT("_APPID_") in another session. You have 10 seconds." H 10
     52           D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
     53           ;
     54           ; Test 3: Check for -100
     55           S bsdxdie=1
     56           D APPADD^BSDX07(.ZZZ,3110126.2,3110126.3,4,"Dr Office",10,"Sam's Note",1)
     57           S APPID=+$P(^BSDXTMP($J,1),U)
     58           D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
     59           I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100",!
     60           K bsdxdie
     61           ;
     62           ; Test 4: Restartable transaction
     63           S bsdxrestart=1
     64           D APPADD^BSDX07(.ZZZ,3110128.2,3110128.3,4,"Dr Office",10,"Sam's Note",1)
     65           S APPID=+$P(^BSDXTMP($J,1),U)
     66           D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
     67           I $P(^DPT(4,"S",3110128.2,0),U,2)'="PC" W "Error in Restartable Transaction",!
     68           ;
     69           ; Test 5: for invalid Appointment ID (-2 and -3)
     70           D APPDEL^BSDX08(.ZZZ,0,"PC",1,"Reasons")
     71           I $P(^BSDXTMP($J,1),"~")'=-2 W "Error in -2",!
     72           D APPDEL^BSDX08(.ZZZ,999999,"PC",1,"Reasons")
     73           I $P(^BSDXTMP($J,1),"~")'=-3 W "Error in -3",!
     74           QUIT
     75           ; Lock the node in another job for testing.
     76UTL(APPID)      L +^BSDXAPPT(APPID) HANG 10 QUIT
     77           ;
    7878APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)         ;EP
    7979        ;Called by RPC: BSDX CANCEL APPOINTMENT
    8080        ;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles
    81     ;Input Parameters:
     81           ;Input Parameters:
    8282        ; - BSDXAPTID is entry number in BSDX APPOINTMENT file
    8383        ; - BSDXTYP is C for clinic-cancelled and PC for patient cancelled
     
    8585        ; - BSDXNOT is user note
    8686        ;
    87     ; Returns error code in recordset field ERRORID. Zero is success.
    88     ; Returns Global Array. Must use this type in RPC.
    89         ;
    90     ; Return Array: set Return and clear array
     87           ; Returns error code in recordset field ERRORID. Zero is success.
     88           ; Returns Global Array. Must use this type in RPC.
     89        ;
     90           ; Return Array: set Return and clear array
    9191        S BSDXY=$NA(^BSDXTMP($J))
    92     K ^BSDXTMP($J)
    93         ;
    94     ; Set min DUZ vars if they don't exist
    95     D ^XBKVAR
    96     ;
    97     ; $ET
    98     N $ET S $ET="G ETRAP^BSDX08"
    99         ;
    100     ; Counter
     92           K ^BSDXTMP($J)
     93        ;
     94           ; Set min DUZ vars if they don't exist
     95           D ^XBKVAR
     96           ;
     97           ; $ET
     98           N $ET S $ET="G ETRAP^BSDX08"
     99        ;
     100           ; Counter
    101101        N BSDXI S BSDXI=0
    102     ; Header Node
    103         S ^BSDXTMP($J,BSDXI)="T00030ERRORID"_$C(30)
    104         ;
    105     ; Lock BSDX node, only to synchronize access to the globals.
    106     ; It's not expected that the error will ever happen as no filing
    107     ; is supposed to take 5 seconds.
    108     L +^BSDXAPPT(BSDXAPTID):5 I '$T D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
    109         ;
    110     ;Restartable Transaction; restore paramters when starting.
    111     ; (Params restored are what's passed here + BSDXI)
    112     TSTART (BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT,BSDXI):T="BSDX CANCEL APPOINTEMENT^BSDX08"
    113         ;
    114     ; Turn off SDAM APPT PROTOCOL BSDX Entries
     102           ; Header Node
     103        S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
     104        ;
     105           ; Lock BSDX node, only to synchronize access to the globals.
     106           ; It's not expected that the error will ever happen as no filing
     107           ; is supposed to take 5 seconds.
     108           L +^BSDXAPPT(BSDXAPTID):5 I '$T D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
     109        ;
     110           ;Restartable Transaction; restore paramters when starting.
     111           ; (Params restored are what's passed here + BSDXI)
     112           TSTART (BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT,BSDXI):T="BSDX CANCEL APPOINTEMENT^BSDX08"
     113        ;
     114           ; Turn off SDAM APPT PROTOCOL BSDX Entries
    115115        N BSDXNOEV
    116116        S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
    117117        ;
    118     ;;;test for error inside transaction. See if %ZTER works
    119     I $G(bsdxdie) S X=1/0
    120     ;;;test
    121     ;;;test for TRESTART
    122     I $G(bsdxrestart) K bsdxrestart TRESTART
    123     ;;;test
    124     ;
    125     ; Check appointment ID and whether it exists
    126     I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q
     118           ;;;test for error inside transaction. See if %ZTER works
     119           I $G(bsdxdie) S X=1/0
     120           ;;;test
     121           ;;;test for TRESTART
     122           I $G(bsdxrestart) K bsdxrestart TRESTART
     123           ;;;test
     124           ;
     125           ; Check appointment ID and whether it exists
     126           I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q
    127127        I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q
    128128        ;
    129129        ; Start Processing:
    130     ; First, add cancellation date to appt entry in BSDX APPOINTMENT
     130           ; First, add cancellation date to appt entry in BSDX APPOINTMENT
    131131        N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node
    132132        N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID
     
    134134        D BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
    135135        ;
    136     ; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
     136           ; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
    137137        N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
    138     ; If the resouce id doesn't exist...
     138           ; If the resouce id doesn't exist...
    139139        I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT
    140     I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
     140           I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
    141141        ; Get zero node of resouce
    142     S BSDXNOD=^BSDXRES(BSDXSC1,0)
    143     ; Get Hosp location
     142           S BSDXNOD=^BSDXRES(BSDXSC1,0)
     143           ; Get Hosp location
    144144        N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4)
    145     ; Error indicator for Hosp Location filing for getting out of routine
    146     N BSDXERR S BSDXERR=0
    147     ; Only file in 2/44 if there is an associated hospital location
    148     I BSDXLOC D  QUIT:BSDXERR 
     145           ; Error indicator for Hosp Location filing for getting out of routine
     146           N BSDXERR S BSDXERR=0
     147           ; Only file in 2/44 if there is an associated hospital location
     148           I BSDXLOC D  QUIT:BSDXERR 
    149149        . I '$D(^SC(BSDXLOC,0)) S BSDXERR=1 D ERR(BSDXI,"-6~BSDX08: Invalid Hosp Location stored in Database") QUIT
    150     . ; Get the IEN of the appointment in the "S" node of ^SC
    151     . N BSDXSCIEN
     150           . ; Get the IEN of the appointment in the "S" node of ^SC
     151           . N BSDXSCIEN
    152152        . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART)
    153     . I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT
     153           . I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT
    154154        . ; Get the appointment node
    155     . S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0))
     155           . S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0))
    156156        . I BSDXNOD="" S BSDXERR=1 D ERR(BSDXI,"-8^BSDX08: Unable to find associated PIMS appointment for this patient") QUIT
    157157        . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2)
    158158        . ; Cancel through BSDXAPI
    159     . N BSDXZ
    160     . D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART)
    161     . I +BSDXZ>0 S BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT
     159           . N BSDXZ
     160           . D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART)
     161           . I +BSDXZ>0 S BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT
    162162        . ; Update Legacy PIMS clinic Availability
    163163        . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
     
    174174        ;See SDCNP0
    175175        N SD,S  ; Start Date
    176     S (SD,S)=BSDXSTART
    177     N I ; Clinic IEN in 44
     176           S (SD,S)=BSDXSTART
     177           N I ; Clinic IEN in 44
    178178        S I=BSDXSCD
    179     ; if day has no schedule in legacy PIMS, forget about this update.
     179           ; if day has no schedule in legacy PIMS, forget about this update.
    180180        Q:'$D(^SC(I,"ST",SD\1,1))
    181     N SL ; Clinic characteristics node (length of appt, when appts start etc)
     181           N SL ; Clinic characteristics node (length of appt, when appts start etc)
    182182        S SL=^SC(I,"SL")
    183     N X ; Hour Clinic Display Begins
    184     S X=$P(SL,U,3)
    185     N STARTDAY ; When does the day start?
    186     S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am
    187     N SB ; ?? Who knows? Day Start - 1 divided by 100.
    188     S SB=STARTDAY-1/100
    189     S X=$P(SL,U,6) ; Now X is Display increments per hour
    190     N HSI ; Slots per hour, try 1
    191     S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4
    192     N SI ; Slots per hour, try 2
    193     S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4
    194     N STR ; ??
    195     S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
    196     N SDDIF ; Slots per hour diff??
    197     S SDDIF=$S(HSI<3:8/HSI,1:2)
     183           N X ; Hour Clinic Display Begins
     184           S X=$P(SL,U,3)
     185           N STARTDAY ; When does the day start?
     186           S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am
     187           N SB ; ?? Who knows? Day Start - 1 divided by 100.
     188           S SB=STARTDAY-1/100
     189           S X=$P(SL,U,6) ; Now X is Display increments per hour
     190           N HSI ; Slots per hour, try 1
     191           S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4
     192           N SI ; Slots per hour, try 2
     193           S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4
     194           N STR ; ??
     195           S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
     196           N SDDIF ; Slots per hour diff??
     197           S SDDIF=$S(HSI<3:8/HSI,1:2)
    198198        S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI
    199199        S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS
    200     N Y ; Hours since start of Date
    201     S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs
    202     N ST  ; ??
    203     ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour
    204     ; Y\1 -> Hours since start of day; * SI: * slots
    205     S ST=Y#1*SI\.6+(Y\1*SI)
    206     N SS ; how many slots are supposed to be taken by appointment
    207     S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)
     200           N Y ; Hours since start of Date
     201           S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs
     202           N ST  ; ??
     203           ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour
     204           ; Y\1 -> Hours since start of day; * SI: * slots
     205           S ST=Y#1*SI\.6+(Y\1*SI)
     206           N SS ; how many slots are supposed to be taken by appointment
     207           S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)
    208208        N I
    209     I Y'<1 D  ; If Hours since start of Date is greater than 1
    210     . ; loop through pattern. Tired of documenting.
    211     . F I=ST+ST:SDDIF D  Q:Y=""  Q:SS'>0
    212     . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" 
    213     . . S S=$E(S,1,I)_Y_$E(S,I+2,999)
    214     . . S SS=SS-1
    215     . . Q:SS'>0
     209           I Y'<1 D  ; If Hours since start of Date is greater than 1
     210           . ; loop through pattern. Tired of documenting.
     211           . F I=ST+ST:SDDIF D  Q:Y=""  Q:SS'>0
     212           . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" 
     213           . . S S=$E(S,1,I)_Y_$E(S,I+2,999)
     214           . . S SS=SS-1
     215           . . Q:SS'>0
    216216        S ^SC(BSDXSCD,"ST",SD\1,1)=S  ; new pattern; global set
    217217        Q
     
    296296ETRAP   ;EP Error trap entry
    297297        N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
    298     ; Rollback, otherwise ^XTER will be empty from future rollback
    299     I $TL>0 TROLLBACK
    300     D ^%ZTER
    301     S $EC=""  ; Clear Error
     298           ; Rollback, otherwise ^XTER will be empty from future rollback
     299           I $TL>0 TROLLBACK
     300           D ^%ZTER
     301           S $EC=""  ; Clear Error
    302302        ; Log error message and send to client
    303     I '$D(BSDXI) N BSDXI S BSDXI=0
     303           I '$D(BSDXI) N BSDXI S BSDXI=0
    304304        D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))
    305305        QUIT
    306     ;
    307     ;;;NB: This is code that is unused in both original and port.
    308     ; ; If not appt in the "S" node is found in ^SC then check associated RPMS Clinic Multiple
    309     ; I BSDXSCIEN="" D  I 'BSDXZ Q  ;Q:BSDXZ
     306           ;
     307           ;;;NB: This is code that is unused in both original and port.
     308           ; ; If not appt in the "S" node is found in ^SC then check associated RPMS Clinic Multiple
     309           ; I BSDXSCIEN="" D  I 'BSDXZ Q  ;Q:BSDXZ
    310310        ; . S BSDXERR="BSDX08: Unable to find associated RPMS appointment for this patient. "
    311311        ; . S BSDXZ=1
    312     ; . ; Check if there are associated RPMS clinics. (not currently used) Does the multiple exist? No, then quit
     312           ; . ; Check if there are associated RPMS clinics. (not currently used) Does the multiple exist? No, then quit
    313313        ; . I '$D(^BSDXRES(BSDXSC1,20)) S BSDXZ=0 QUIT
    314     ; . ; Loop through the multiple. Get Location and then the ^SC "S" node IEN.
     314           ; . ; Loop through the multiple. Get Location and then the ^SC "S" node IEN.
    315315        ; . N BSDX1 S BSDX1=0
    316316        ; . F  S BSDX1=$O(^BSDXRES(BSDXSC1,20,BSDX1)) Q:'+BSDX1  Q:BSDXZ=0  D
  • Scheduling/trunk/m/BSDX09.m

    r984 r1041  
    11BSDX09  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 10/20/10 4:16pm
    2         ;;1.41;BSDX;;Sep 07, 2010;Build 7
     2        ;;1.42;BSDX;;Dec 07, 2010;Build 7
    33        ;
    44        ; Change Log:
     
    1111        ; UJO/TH - v 1.3 on 3100715 - Change SSN to PID and get PID field instead
    1212        ;
    13     ; UJO/TH - v 1.42 on 3101020 - Add Sex field.
    14     ;
     13           ; UJO/TH - v 1.42 on 3101020 - Add Sex field.
     14           ;
    1515GETREGA(BSDXRET,BSDXPAT)               ;EP
    1616        ;
  • Scheduling/trunk/m/BSDX11.m

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

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

    r968 r1041  
    1 BSDX13  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:17pm
    2         ;;1.41;BSDX;;Sep 29, 2010
     1BSDX13  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 6:05pm
     2        ;;1.42;BSDX;;Dec 07, 2010
    33           ;
    44           ; Change Log:
     
    3131        ; S %DT="X" D ^%DT
    3232        ; I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid End Date") Q
    33         S BSDXEND=$P(Y,".")_".99999"
     33        S BSDXEND=$P(BSDXEND,".")_".99999"
    3434        I '+BSDXRESD D ERR(0,"AVDELDT-BSDX13: Invalid Resource ID") Q
    3535        ;
     
    4646        I '+$G(BSDXI) N BSDXI S BSDXI=999999
    4747        S BSDXI=BSDXI+1
    48         D ERR(0,"BSDX13 M Error: <"_$G(%ZTERROR)_">")
     48        D ERR(0,"BSDX13 M Error: <"_$G(%ZTERZE)_">")
    4949        Q
    5050        ;
  • Scheduling/trunk/m/BSDX14.m

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

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

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

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

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

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

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

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

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

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

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

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

    r1036 r1041  
    1 BSDX26  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 3:08am
    2     ;;1.42;BSDX;;Sep 29, 2010
    3     ; Change History:
    4     ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
    5     ; --> Thanks to Zach Gonzalez and Rick Marshall
    6     ; 3101205 - UJO/SMH - Extensive refactoring.
    7     ;
    8     ; Error Reference:
    9     ; -1: Appt ID is not a number
    10     ; -2: Appt IEN is not in ^BSDXAPPT
    11     ; -3: FM Failure to file WP field in ^BSDXAPPT
    12     ;
    13 EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE)  ;EP
    14     ;Entry point for debugging
    15     ;
    16     D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
    17     Q
    18 UT ; Unit Tests
    19     ; Test 1: Make sure this damn thing works
    20     N ZZZ
    21     N %H S %H=$H
    22     N NOTE S NOTE="New Note "_%H
    23     D EDITAPT(.ZZZ,188,NOTE)
    24     I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR",! B
    25     ; Test 2: Test Errors -1 and -2
    26     N ZZZ
    27     N NOTE S NOTE="Nothing important"
    28     D EDITAPT(.ZZZ,"BLAHBLAH",NOTE)
    29     I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",! B
    30     D EDITAPT(.ZZZ,298734322,NOTE)
    31     I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",! B
    32     ; Test 4: M Error
    33     N bsdxdie S bsdxdie=1
    34     D EDITAPT(.ZZZ,188,NOTE)
    35     I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B
    36     k bsdxdie
    37     ; Test 5: Trestart
    38     N bsdxrestart S bsdxrestart=1
    39     N %H S %H=$H
    40     N NOTE S NOTE="New Note "_%H
    41     D EDITAPT(.ZZZ,188,NOTE)
    42     I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B
    43     ; Test 6: for Hosp Location Update
    44     N DATE S DATE=$$NOW^XLFDT()
    45     S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
    46     D APPADD^BSDX07(.ZZZ,DATE,DATE+.001,3,"Dr Office",30,"Old Note",1)
    47     N APPID S APPID=+$P(^BSDXTMP($J,1),U)
    48     D EDITAPT(.ZZZ,APPID,"New Note")
    49     I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B
    50     I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B
    51     QUIT
    52     ;
    53 EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE)   ;EP Edit appointment (only note text can be edited)
    54     ; Called by RPC: BSDX EDIT APPOINTMENT
    55     ;
    56     ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
    57     ;
    58     ; Parameters:
    59     ; - BSDXY: Global Return (RPC must be set to Global Array)
    60     ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
    61     ; - BSDXNOTE: New note
    62     ;
    63     ; Return:
    64     ; ADO.net Recordset having 1 field: ERRORID
    65     ; If Okay: -1; otherwise, positive integer with message
    66     ;
    67     ; Return Array; set Return and clear array
    68     S BSDXY=$NA(^BSDXTMP($J))
    69     K ^BSDXTMP($J)
    70     ; ET
    71     N $ET S $ET="G ETRAP^BSDX26"
    72     ; Set up basic DUZ variables
    73     D ^XBKVAR
    74     ; Counter
    75     N BSDXI S BSDXI=0
    76     ; Header Node
    77     S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30)
    78     ; Restartable txn for GT.M. Restored vars are Params + BSDXI.
    79     TSTART (BSDXY,BSDXAPTID,BSDXNOTE,BSDXI):T="BSDX EDIT APPOINTMENT^BSDX26"
    80     ;
    81     ;;;test for error inside transaction. See if %ZTER works
    82     I $G(bsdxdie) S X=1/0
    83     ;;;test
    84     ;;;test for TRESTART
    85     I $G(bsdxrestart) K bsdxrestart TRESTART
    86     ;;;test
    87     ;
    88     ; Validate Appointment ID
    89     I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT
    90     I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT
    91     ; Put the WP in decendant fields from the root to file as a WP field
    92     S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
    93     I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
    94     N BSDXMSG ; Message in case of error in filing.
    95     I $D(BSDXNOTE(.5)) D
    96     . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
    97     I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
    98     ;
    99     ; Now file in file 44:
    100     N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
    101     N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
    102     N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
    103     N BSDXRES S BSDXRES=0 ; Result
    104     ; Update Note only if we have a linked hospital location.
    105     I HLIEN S BSDXRES=$$UPDATENOTE^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
    106     ; If we get an error (denoted by -1 in BSDXRES), return error to client
    107     I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES) QUIT
    108     ;Return Recordset
    109     TCOMMIT
    110     S BSDXI=BSDXI+1
    111     S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
    112     S BSDXI=BSDXI+1
    113     S ^BSDXTMP($J,BSDXI)=$C(31)
    114     QUIT
    115     ;
    116 ERR(BSDXI,BSDXERR)  ;Error processing
    117     S BSDXI=BSDXI+1
    118     S BSDXERR=$TR(BSDXERR,"^","~")
    119     I $TL>0 TROLLBACK
    120     S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
    121     S BSDXI=BSDXI+1
    122     S ^BSDXTMP($J,BSDXI)=$C(31)
    123     QUIT
    124     ;
    125 ETRAP   ;EP Error trap entry
    126     N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
    127     I $TL>0 TROLLBACK
    128     D ^%ZTER
    129     S $EC=""
    130     I '$D(BSDXI) N BSDXI S BSDXI=0
    131     D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE))
    132     Q
     1BSDX26   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:38pm
     2           ;;1.42;BSDX;;Dec 07, 2010
     3           ; Change History:
     4           ; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
     5           ; --> Thanks to Zach Gonzalez and Rick Marshall
     6           ; 3101205 - UJO/SMH - Extensive refactoring.
     7           ;
     8           ; Error Reference:
     9           ; -1: Appt ID is not a number
     10           ; -2: Appt IEN is not in ^BSDXAPPT
     11           ; -3: FM Failure to file WP field in ^BSDXAPPT
     12           ;
     13EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE)      ;EP
     14           ;Entry point for debugging
     15           ;
     16           D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
     17           Q
     18UT      ; Unit Tests
     19           ; Test 1: Make sure this damn thing works
     20           N ZZZ
     21           N %H S %H=$H
     22           N NOTE S NOTE="New Note "_%H
     23           D EDITAPT(.ZZZ,188,NOTE)
     24           I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR",! B
     25           ; Test 2: Test Errors -1 and -2
     26           N ZZZ
     27           N NOTE S NOTE="Nothing important"
     28           D EDITAPT(.ZZZ,"BLAHBLAH",NOTE)
     29           I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",! B
     30           D EDITAPT(.ZZZ,298734322,NOTE)
     31           I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",! B
     32           ; Test 4: M Error
     33           N bsdxdie S bsdxdie=1
     34           D EDITAPT(.ZZZ,188,NOTE)
     35           I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B
     36           k bsdxdie
     37           ; Test 5: Trestart
     38           N bsdxrestart S bsdxrestart=1
     39           N %H S %H=$H
     40           N NOTE S NOTE="New Note "_%H
     41           D EDITAPT(.ZZZ,188,NOTE)
     42           I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B
     43           ; Test 6: for Hosp Location Update
     44           N DATE S DATE=$$NOW^XLFDT()
     45           S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
     46           D APPADD^BSDX07(.ZZZ,DATE,DATE+.001,3,"Dr Office",30,"Old Note",1)
     47           N APPID S APPID=+$P(^BSDXTMP($J,1),U)
     48           D EDITAPT(.ZZZ,APPID,"New Note")
     49           I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B
     50           I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B
     51           QUIT
     52           ;
     53EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE)         ;EP Edit appointment (only note text can be edited)
     54           ; Called by RPC: BSDX EDIT APPOINTMENT
     55           ;
     56           ; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
     57           ;
     58           ; Parameters:
     59           ; - BSDXY: Global Return (RPC must be set to Global Array)
     60           ; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
     61           ; - BSDXNOTE: New note
     62           ;
     63           ; Return:
     64           ; ADO.net Recordset having 1 field: ERRORID
     65           ; If Okay: -1; otherwise, positive integer with message
     66           ;
     67           ; Return Array; set Return and clear array
     68           S BSDXY=$NA(^BSDXTMP($J))
     69           K ^BSDXTMP($J)
     70           ; ET
     71           N $ET S $ET="G ETRAP^BSDX26"
     72           ; Set up basic DUZ variables
     73           D ^XBKVAR
     74           ; Counter
     75           N BSDXI S BSDXI=0
     76           ; Header Node
     77           S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
     78           ; Restartable txn for GT.M. Restored vars are Params + BSDXI.
     79           TSTART (BSDXY,BSDXAPTID,BSDXNOTE,BSDXI):T="BSDX EDIT APPOINTMENT^BSDX26"
     80           ;
     81           ;;;test for error inside transaction. See if %ZTER works
     82           I $G(bsdxdie) S X=1/0
     83           ;;;test
     84           ;;;test for TRESTART
     85           I $G(bsdxrestart) K bsdxrestart TRESTART
     86           ;;;test
     87           ;
     88           ; Validate Appointment ID
     89           I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT
     90           I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT
     91           ; Put the WP in decendant fields from the root to file as a WP field
     92           S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
     93           I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
     94           N BSDXMSG ; Message in case of error in filing.
     95           I $D(BSDXNOTE(.5)) D
     96           . D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
     97           I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
     98           ;
     99           ; Now file in file 44:
     100           N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
     101           N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
     102           N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
     103           N BSDXRES S BSDXRES=0 ; Result
     104           ; Update Note only if we have a linked hospital location.
     105           I HLIEN S BSDXRES=$$UPDATENOTE^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
     106           ; If we get an error (denoted by -1 in BSDXRES), return error to client
     107           I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES) QUIT
     108           ;Return Recordset
     109           TCOMMIT
     110           S BSDXI=BSDXI+1
     111           S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
     112           S BSDXI=BSDXI+1
     113           S ^BSDXTMP($J,BSDXI)=$C(31)
     114           QUIT
     115           ;
     116ERR(BSDXI,BSDXERR)      ;Error processing
     117           S BSDXI=BSDXI+1
     118           S BSDXERR=$TR(BSDXERR,"^","~")
     119           I $TL>0 TROLLBACK
     120           S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
     121           S BSDXI=BSDXI+1
     122           S ^BSDXTMP($J,BSDXI)=$C(31)
     123           QUIT
     124           ;
     125ETRAP     ;EP Error trap entry
     126           N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
     127           I $TL>0 TROLLBACK
     128           D ^%ZTER
     129           S $EC=""
     130           I '$D(BSDXI) N BSDXI S BSDXI=0
     131           D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE))
     132           Q
  • 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
  • Scheduling/trunk/m/BSDX28.m

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

    r1036 r1041  
    1 BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 6:05am
    2         ;;1.42;BSDX;;Sep 29, 2010
     1BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:39pm
     2        ;;1.42;BSDX;;Dec 07, 2010
    33        ;
    44        ; Change Log:
    55        ; v1.3 by WV/SMH on 3100713
    66        ; - Beginning and Ending dates passed as FM Dates
    7     ; v1.42 by WV/SMH on 3101023
    8     ; - Transaction moved; now restartable too.
    9     ; --> Thanks to Zach Gonzalez and Rick Marshall.
    10     ; - Refactoring of major portions of routine
     7           ; v1.42 by WV/SMH on 3101023
     8           ; - Transaction moved; now restartable too.
     9           ; --> Thanks to Zach Gonzalez and Rick Marshall.
     10           ; - Refactoring of major portions of routine
    1111        ;
    1212BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)   ;EP
     
    1919        ;Copy appointments from HOSPITAL LOCATION entry BSDX44 to BSDX RESOURCE entry BSDXRES
    2020        ;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
    21     ;Called by RPC: BSDX COPY APPOINTMENTS
    22         ;
    23     ; Parameters:
    24     ; - BSDXY: Global Return
    25     ; - BSDXRES: BSDX RESOURCE to copy appointments to
    26     ; - BSDX44: Hospital Location IEN to copy appointments from
    27     ; - BSDXBEG: Beginning Date in FM Format
    28     ; - BSDXEND: End Date in FM Format
    29     ;
     21           ;Called by RPC: BSDX COPY APPOINTMENTS
     22        ;
     23           ; Parameters:
     24           ; - BSDXY: Global Return
     25           ; - BSDXRES: BSDX RESOURCE to copy appointments to
     26           ; - BSDX44: Hospital Location IEN to copy appointments from
     27           ; - BSDXBEG: Beginning Date in FM Format
     28           ; - BSDXEND: End Date in FM Format
     29           ;
    3030        ;Returns ADO Recordset containing TASK_NUMBER and ERRORID
    3131        ;
    32     ; Return Array
     32           ; Return Array
    3333        S BSDXY=$NA(^BSDXTMP($J))
    34     K ^BSDXTMP($J)
    35     ; $ET
    36     N $ET S $ET="G ETRAP^BSDX29"
     34           K ^BSDXTMP($J)
     35           ; $ET
     36           N $ET S $ET="G ETRAP^BSDX29"
    3737        ; Counter
    38     N BSDXI S BSDXI=0
    39     ; Header Node
    40         S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00020ERRORID"_$C(30)
    41         ;
    42     ; Make dates inclusive; add 1 to FM dates
    43     S BSDXBEG=BSDXBEG-1
     38           N BSDXI S BSDXI=0
     39           ; Header Node
     40        S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30)
     41        ;
     42           ; Make dates inclusive; add 1 to FM dates
     43           S BSDXBEG=BSDXBEG-1
    4444        S BSDXEND=BSDXEND+1
    4545        ;
    46     ; Taskman variables
    47     N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
     46           ; Taskman variables
     47           N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
    4848        ; Task Load
    4949        S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS"
     
    6161        ;
    6262ZTM     ;EP - Taskman entry point
    63     ; Variables set up in ZTSAVE above
    64     ;
     63           ; Variables set up in ZTSAVE above
     64           ;
    6565        Q:'$D(ZTSK)
    66     ; $ET
    67     N $ET S $ET="G ZTMERR^BSDX29"
     66           ; $ET
     67           N $ET S $ET="G ZTMERR^BSDX29"
    6868        ; Txn
    69     TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29"
     69           TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29"
    7070        ;$O through ^SC(BSDX44,"S",
    7171        N BSDXCNT S BSDXCNT=0  ; Count of Copied Appointments
    72     N BSDXQUIT S BSDXQUIT=0  ; Quit Flag to be retrieved from an external proc
     72           N BSDXQUIT S BSDXQUIT=0  ; Quit Flag to be retrieved from an external proc
    7373        ; Set Count
    74     S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
     74           S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
    7575        ; Loop through dates here.
    76     F  S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG  Q:BSDXBEG>BSDXEND  Q:BSDXQUIT  D
    77     . ; Loop through Entries in each date in the subsubfile.
    78     . ; Quit if we are at the end or if a remote process requests a quit.
    79     . N BSDXIEN S BSDXIEN=0
     76           F  S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG  Q:BSDXBEG>BSDXEND  Q:BSDXQUIT  D
     77           . ; Loop through Entries in each date in the subsubfile.
     78           . ; Quit if we are at the end or if a remote process requests a quit.
     79           . N BSDXIEN S BSDXIEN=0
    8080        . F  S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN  Q:BSDXQUIT  D
    8181        . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node
     
    8383        . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag
    8484        . . Q:BSDXCAN="C"  ; Quit if appt cancelled
    85     . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
    86     . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
     85           . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
     86           . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
    8787        . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
    8888        . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
     
    100100ZTMERR  ; For now, error from TM is only in trap; not returned to client.
    101101        N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
    102     ; Rollback before logging the error
    103     I $TL>0 TROLLBACK
     102           ; Rollback before logging the error
     103           I $TL>0 TROLLBACK
    104104        D ^%ZTER
    105     S $EC="" ; Clear Error
     105           S $EC="" ; Clear Error
    106106        QUIT
    107107        ;
     
    148148ERR(BSDXI,BSDXCNT,BSDXERR)      ;Error processing
    149149        S BSDXI=BSDXI+1
    150     S BSDXERR=$TR(BSDXERR,"^","~")
     150           S BSDXERR=$TR(BSDXERR,"^","~")
    151151        S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
    152152        S BSDXI=BSDXI+1
     
    156156ETRAP   ;EP Error trap entry
    157157        ; No Txn here. So don't rollback anything
    158     N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
    159     D ^%ZTER
    160     S $EC="" ; Clear error
     158           N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
     159           D ^%ZTER
     160           S $EC="" ; Clear error
    161161        I '$D(BSDXI) N BSDXI S BSDXI=0
    162162        D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
  • Scheduling/trunk/m/BSDX2E.m

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

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

    r1036 r1041  
    1 BSDX31  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 8:25am
    2     ;;1.42;BSDX;;Sep 29, 2010
    3     ; Change Log:
    4     ; v1.42 Oct 23 2010 WV/SMH
    5     ; - Change transaction to restartable. Thanks to Zach Gonzalez
    6     ; --> and Rick Marshall for their help.
    7     ; v1.42 Dec 6 2010: Extensive refactoring
    8     ;
    9     ; Error Reference:
    10     ; -1: zero or null Appt ID
    11     ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT)
    12     ; -3: No-show flag is invalid
    13     ; -100: M Error
    14     ;
    15     ;
    16 NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
    17     ;Entry point for debugging
    18     ;
    19     D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
    20     Q
    21     ;
    22 UT ; Unit Tests
    23     ; Test 1: Sanity Check
    24     N ZZZ ; Garbage return variable
    25     N DATE S DATE=$$NOW^XLFDT()
    26     S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
    27     D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1)
    28     N APPID S APPID=+$P(^BSDXTMP($J,1),U)
    29     D NOSHOW(.ZZZ,APPID,1)
    30     I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B
    31     I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B
    32     ; Test 2: Undo noshow
    33     D NOSHOW(.ZZZ,APPID,0)
    34     I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B
    35     I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B
    36     ; Test 3: -1
    37     D NOSHOW(.ZZZ,"",0)
    38     I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B
    39     ; Test 4: -2
    40     D NOSHOW(.ZZZ,2938748233,0)
    41     I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B
    42     QUIT
    43 NOSHOW(BSDXY,BSDXAPTID,BSDXNS)         ;EP - No show a patient
    44     ; Called by RPC: BSDX NOSHOW
    45     ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2
    46     ;
    47     ; Parameters:
    48     ; BSDXY: Global Return
    49     ; BSDXAPTID is entry number in BSDX APPOINTMENT file
    50     ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
    51     ;
    52     ; Returns ADO.net record set with fields
    53     ; - ERRORID; ERRORTEXT
    54     ; ERRORID of 1 is okay
    55     ; Anything else is an error.
    56     ;
    57     ; Return Array; set and clear
    58     S BSDXY=$NA(^BSDXTMP($J))
    59     K ^BSDXTMP($J)
    60     ; $ET
    61     N $ET S $ET="G ETRAP^BSDX31"
    62     ; Basline vars
    63     D ^XBKVAR  ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist
    64     ; Counter
    65     N BSDXI S BSDXI=0
    66     ; Header Node
    67     S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
    68     ; Begin transaction
    69     TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29"
    70     ; Turn off SDAM APPT PROTOCOL BSDX Entries
    71     N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
    72     ; Appointment ID check
    73     I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q
    74     I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
    75     ; Noshow value check - Must be 1 or 0
    76     S BSDXNS=+BSDXNS
    77     I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
    78     ; Get Some data
    79     N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node
    80     N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
    81     N BSDXSTART S BSDXSTART=$P(BSDXNOD,U)  ; Start Date/Time
    82     ; Edit BSDX APPOINTMENT entry
    83     N BSDXMSG  ;
    84     D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG)  ;Edit BSDX APPOINTMENT entry NOSHOW field
    85     I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q
    86     ; Edit File 2 "S" node entry
    87     N BSDXZ,BSDXERR ; Error variables to control looping
    88     S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
    89     ; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2
    90     I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D  I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q
    91     . S BSDXNOD=^BSDXRES(BSDXSC1,0)
    92     . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
    93     . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS)
    94     ;
    95     TCOMMIT
    96     S BSDXI=BSDXI+1
    97     S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
    98     S BSDXI=BSDXI+1
    99     S ^BSDXTMP($J,BSDXI)=$C(31)
    100     QUIT
    101     ;
    102 APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS)            ;
    103     ; update file 2 info
    104     ;Set noshow for patient BSDXDFN in clinic BSDXSC1
    105     ;at time BSDXSD
    106     N BSDXC,%H,BSDXCDT,BSDXIEN
    107     N BSDXIENS,BSDXFDA,BSDXMSG
    108     S %H=$H D YMD^%DTC
    109     S BSDXCDT=X+%
    110     ;
    111     S BSDXIENS=BSDXSD_","_BSDXDFN_","
    112     I +BSDXNS D
    113     . S BSDXFDA(2.98,BSDXIENS,3)="N"
    114     . S BSDXFDA(2.98,BSDXIENS,14)=DUZ
    115     . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT
    116     E  D
    117     . S BSDXFDA(2.98,BSDXIENS,3)=""
    118     . S BSDXFDA(2.98,BSDXIENS,14)=""
    119     . S BSDXFDA(2.98,BSDXIENS,15)=""
    120     K BSDXIEN
    121     D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
    122     S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1))
    123     Q
    124     ;
    125 BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG)   ;
    126     ;
    127     N BSDXFDA,BSDXIENS
    128     S BSDXIENS=BSDXAPTID_","
    129     S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW
    130     D FILE^DIE("","BSDXFDA","BSDXMSG")
    131     QUIT
    132     ;
    133 NOSEVT(BSDXPAT,BSDXSTART,BSDXSC)    ;EP Called by BSDX NOSHOW APPOINTMENT event
    134     ;when appointments NOSHOW via PIMS interface.
    135     ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
    136     ;
    137     Q:+$G(BSDXNOEV)
    138     Q:'+$G(BSDXSC)
    139     Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
    140     N BSDXSTAT,BSDXFOUND,BSDXRES
    141     S BSDXSTAT=1
    142     S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
    143     S BSDXFOUND=0
    144     I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
    145     I BSDXFOUND D NOSEVT3(BSDXRES) Q
    146     I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
    147     I BSDXFOUND D NOSEVT3(BSDXRES)
    148     Q
    149     ;
    150 NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
    151     ;Get appointment id in BSDXAPT
    152     ;If found, call BSDXNOS(BSDXAPPT) and return 1
    153     ;else return 0
    154     N BSDXFOUND,BSDXAPPT
    155     S BSDXFOUND=0
    156     Q:'+$G(BSDXRES) BSDXFOUND
    157     Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
    158     S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
    159     . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
    160     . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
    161     I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT)
    162     Q BSDXFOUND
    163     ;
    164 NOSEVT3(BSDXRES)    ;
    165     ;Call RaiseEvent to notify GUI clients
    166     ;
    167     N BSDXRESN
    168     S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
    169     Q:BSDXRESN=""
    170     S BSDXRESN=$P(BSDXRESN,"^")
    171     D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
    172     Q
    173     ;
    174     ;
    175 ERR(BSDXERID,ERRTXT)    ;Error processing
    176     S BSDXI=BSDXI+1
    177     TROLLBACK
    178     S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
    179     S BSDXI=BSDXI+1
    180     S ^BSDXTMP($J,BSDXI)=$C(31)
    181     Q
    182     ;
    183 ETRAP   ;EP Error trap entry
    184     D ^%ZTER
    185     I '$D(BSDXI) N BSDXI S BSDXI=999999
    186     S BSDXI=BSDXI+1
    187     D ERR(0,"BSDX31 Error: "_$G(%ZTERROR))
    188     Q
    189     ;
    190 IMHERE(BSDXRES) ;EP
    191     ;Entry point for BSDX IM HERE remote procedure
    192     S BSDXRES=1
    193     Q
    194     ;
     1BSDX31   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:39pm
     2           ;;1.42;BSDX;;Dec 07, 2010
     3           ; Change Log:
     4           ; v1.42 Oct 23 2010 WV/SMH
     5           ; - Change transaction to restartable. Thanks to Zach Gonzalez
     6           ; --> and Rick Marshall for their help.
     7           ; v1.42 Dec 6 2010: Extensive refactoring
     8           ;
     9           ; Error Reference:
     10           ; -1: zero or null Appt ID
     11           ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT)
     12           ; -3: No-show flag is invalid
     13           ; -4: Filing of No-show in ^BSDXAPPT failed
     14           ; -5: Filing of No-show in ^DPT failed (BSDXAPI error)
     15           ; -100: M Error
     16           ;
     17           ;
     18NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
     19           ;Entry point for debugging
     20           ;
     21           D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
     22           Q
     23           ;
     24UT      ; Unit Tests
     25           ; Test 1: Sanity Check
     26           N ZZZ ; Garbage return variable
     27           N DATE S DATE=$$NOW^XLFDT()
     28           S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
     29           D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1)
     30           N APPID S APPID=+$P(^BSDXTMP($J,1),U)
     31           D NOSHOW(.ZZZ,APPID,1)
     32           I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B
     33           I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B
     34           ; Test 2: Undo noshow
     35           D NOSHOW(.ZZZ,APPID,0)
     36           I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B
     37           I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B
     38           ; Test 3: -1
     39           D NOSHOW(.ZZZ,"",0)
     40           I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B
     41           ; Test 4: -2
     42           D NOSHOW(.ZZZ,2938748233,0)
     43           I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B
     44           ; Test 5: -3
     45           D NOSHOW(.ZZZ,APPID,3)
     46           I $P(^BSDXTMP($J,1),U)'=-3 W "ERROR T5",! B
     47           ; Test 6: Mumps error (-100)
     48           s bsdxdie=1
     49           D NOSHOW(.ZZZ,APPID,1)
     50           I $P(^BSDXTMP($J,1),U)'=-100 W "ERROR T6",! B
     51           k bsdxdie
     52           ; Test 7: Restartable transaction
     53           s bsdxrestart=1
     54           D NOSHOW(.ZZZ,APPID,1)
     55           I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T7",! B
     56           QUIT
     57NOSHOW(BSDXY,BSDXAPTID,BSDXNS)          ;EP - No show a patient
     58           ; Called by RPC: BSDX NOSHOW
     59           ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2
     60           ;
     61           ; Parameters:
     62           ; BSDXY: Global Return
     63           ; BSDXAPTID is entry number in BSDX APPOINTMENT file
     64           ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
     65           ;
     66           ; Returns ADO.net record set with fields
     67           ; - ERRORID; ERRORTEXT
     68           ; ERRORID of 1 is okay
     69           ; Anything else is an error.
     70           ;
     71           ; Return Array; set and clear
     72           S BSDXY=$NA(^BSDXTMP($J))
     73           K ^BSDXTMP($J)
     74           ; $ET
     75           N $ET S $ET="G ETRAP^BSDX31"
     76           ; Basline vars
     77           D ^XBKVAR  ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist
     78           ; Counter
     79           N BSDXI S BSDXI=0
     80           ; Header Node
     81           S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30)
     82           ; Begin transaction
     83           TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29"
     84           ;;;test for error inside transaction. See if %ZTER works
     85           I $G(bsdxdie) S X=1/0
     86           ;;;TEST
     87           ;;;test for TRESTART
     88           I $G(bsdxrestart) K bsdxrestart TRESTART
     89           ;;;test
     90           ; Turn off SDAM APPT PROTOCOL BSDX Entries
     91           N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
     92           ; Appointment ID check
     93           I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q
     94           I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
     95           ; Noshow value check - Must be 1 or 0
     96           S BSDXNS=+BSDXNS
     97           I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
     98           ; Get Some data
     99           N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node
     100           N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
     101           N BSDXSTART S BSDXSTART=$P(BSDXNOD,U)  ; Start Date/Time
     102           ; Edit BSDX APPOINTMENT entry
     103           N BSDXMSG  ;
     104           D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG)  ;Edit BSDX APPOINTMENT entry NOSHOW field
     105           I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q
     106           ; Edit File 2 "S" node entry
     107           N BSDXZ,BSDXERR ; Error variables to control looping
     108           S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
     109           ; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2
     110           I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D  I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q
     111           . S BSDXNOD=^BSDXRES(BSDXSC1,0)
     112           . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
     113           . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS)
     114           ;
     115           TCOMMIT
     116           S BSDXI=BSDXI+1
     117           S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
     118           S BSDXI=BSDXI+1
     119           S ^BSDXTMP($J,BSDXI)=$C(31)
     120           QUIT
     121           ;
     122APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS)               ;
     123           ; update file 2 info
     124           ;Set noshow for patient BSDXDFN in clinic BSDXSC1
     125           ;at time BSDXSD
     126           N BSDXC,%H,BSDXCDT,BSDXIEN
     127           N BSDXIENS,BSDXFDA,BSDXMSG
     128           S %H=$H D YMD^%DTC
     129           S BSDXCDT=X+%
     130           ;
     131           S BSDXIENS=BSDXSD_","_BSDXDFN_","
     132           I +BSDXNS D
     133           . S BSDXFDA(2.98,BSDXIENS,3)="N"
     134           . S BSDXFDA(2.98,BSDXIENS,14)=DUZ
     135           . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT
     136           E  D
     137           . S BSDXFDA(2.98,BSDXIENS,3)=""
     138           . S BSDXFDA(2.98,BSDXIENS,14)=""
     139           . S BSDXFDA(2.98,BSDXIENS,15)=""
     140           K BSDXIEN
     141           D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
     142           S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1))
     143           Q
     144           ;
     145BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG)         ;
     146           ;
     147           N BSDXFDA,BSDXIENS
     148           S BSDXIENS=BSDXAPTID_","
     149           S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW
     150           D FILE^DIE("","BSDXFDA","BSDXMSG")
     151           QUIT
     152           ;
     153NOSEVT(BSDXPAT,BSDXSTART,BSDXSC)           ;EP Called by BSDX NOSHOW APPOINTMENT event
     154           ;when appointments NOSHOW via PIMS interface.
     155           ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
     156           ;
     157           Q:+$G(BSDXNOEV)
     158           Q:'+$G(BSDXSC)
     159           Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
     160           N BSDXSTAT,BSDXFOUND,BSDXRES
     161           S BSDXSTAT=1
     162           S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
     163           S BSDXFOUND=0
     164           I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
     165           I BSDXFOUND D NOSEVT3(BSDXRES) Q
     166           I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
     167           I BSDXFOUND D NOSEVT3(BSDXRES)
     168           Q
     169           ;
     170NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)     ;
     171           ;Get appointment id in BSDXAPT
     172           ;If found, call BSDXNOS(BSDXAPPT) and return 1
     173           ;else return 0
     174           N BSDXFOUND,BSDXAPPT
     175           S BSDXFOUND=0
     176           Q:'+$G(BSDXRES) BSDXFOUND
     177           Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
     178           S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
     179           . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
     180           . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
     181           I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT)
     182           Q BSDXFOUND
     183           ;
     184NOSEVT3(BSDXRES)           ;
     185           ;Call RaiseEvent to notify GUI clients
     186           ;
     187           N BSDXRESN
     188           S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
     189           Q:BSDXRESN=""
     190           S BSDXRESN=$P(BSDXRESN,"^")
     191           D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
     192           Q
     193           ;
     194           ;
     195ERR(BSDXERID,ERRTXT)       ;Error processing
     196           S BSDXI=BSDXI+1
     197           S ERRTXT=$TR(ERRTXT,"^","~")
     198           I $TL>0 TROLLBACK
     199           S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
     200           S BSDXI=BSDXI+1
     201           S ^BSDXTMP($J,BSDXI)=$C(31)
     202           QUIT
     203           ;
     204ETRAP     ;EP Error trap entry
     205           N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
     206           ; Rollback, otherwise ^XTER will be empty from future rollback
     207           I $TL>0 TROLLBACK
     208           D ^%ZTER
     209           S $EC="" ; Clear Error
     210           ; Send to client
     211           I '$D(BSDXI) N BSDXI S BSDXI=0
     212           D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE))
     213           QUIT
     214           ;
     215IMHERE(BSDXRES) ;EP
     216           ;Entry point for BSDX IM HERE remote procedure
     217           S BSDXRES=1
     218           Q
     219           ;
  • Scheduling/trunk/m/BSDX32.m

    r968 r1041  
    11BSDX32  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:21am
    2         ;;1.41;BSDX;;Sep 29, 2010
     2        ;;1.42;BSDX;;Dec 07, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX33.m

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

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

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

    r1035 r1041  
    1 BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 12/6/10 6:01am
    2         ;;1.42;BSDX;;Sep 29, 2010;Build 7
     1BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 12/6/10 5:50pm
     2        ;;1.42;BSDX;;Dec 07, 2010;Build 7
    33        ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
    44        ;local mods (many) by WV/SMH
    55        ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
    66        ; Change History:
     7           ; 2010-11-5:
    78        ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
    89        ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
    9     ; 2010-11-12:
    10     ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well.
    11     ; 2010-12-5
    12     ; Added an entry point to update the patient note in file 44.
    13     ; 2010-12-6
    14     ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
     10           ; 2010-11-12:
     11           ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well.
     12           ; 2010-12-5
     13           ; Added an entry point to update the patient note in file 44.
     14           ; 2010-12-6
     15           ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
     16           ; 2010-12-8
     17           ; Removed restriction on max appt length. Even though this restriction
     18           ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I
     19           ; will ignore it here too.
    1520        ;
    1621MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO)       ; Simplified PEP w/ parameters for $$MAKE - making appointment
     
    5156        I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
    5257        ;
    53         I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
     58        ;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details.
    5459        I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
    5560        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")
     
    280285        Q $S(X:1,1:0)
    281286        ;
    282 UPDATENOTE(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
    283     ; PAT = DFN
    284     ; CLINIC = SC IEN
    285     ; DATE = FM Date/Time of Appointment
    286     ;
    287     ; Returns:
    288     ; 0 if okay
    289     ; -1 if failure
    290     N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
    291     I SCIEN<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
    292     N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
    293     S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
    294     N BSDXERR
    295     D FILE^DIE("","BSDXFDA","BSDXERR")
    296     I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)
    297     QUIT 0
     287UPDATENOTE(PAT,CLINIC,DATE,NOTE)        ; PEP; Update Note in ^SC for patient's appointment @ DATE
     288           ; PAT = DFN
     289           ; CLINIC = SC IEN
     290           ; DATE = FM Date/Time of Appointment
     291           ;
     292           ; Returns:
     293           ; 0 if okay
     294           ; -1 if failure
     295           N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
     296           I SCIEN<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
     297           N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
     298           S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
     299           N BSDXERR
     300           D FILE^DIE("","BSDXFDA","BSDXERR")
     301           I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)
     302           QUIT 0
  • Scheduling/trunk/m/BSDXGPRV.m

    r1005 r1041  
    11BSDXGPRV        ; WV/SMH - WINDOWS SCHEDULING RPCS ; 11/2/10 4:27pm
    2         ;;1.41;BSDX;;Sep 29, 2010
     2        ;;1.42;BSDX;;Dec 07, 2010
    33        ;
    44        ;
Note: See TracChangeset for help on using the changeset viewer.