Changeset 996 for Scheduling/trunk


Ignore:
Timestamp:
Oct 31, 2010, 6:15:06 AM (14 years ago)
Author:
Sam Habiel
Message:

Fix restartable transactions. Unit tests. Errors now logged correctly in %ZTER.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • Scheduling/trunk/m/BSDX07.m

    r988 r996  
    1 BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS  ; 10/4/10 6:22pm
     1BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS  ; 10/24/10 12:07am
    22        ;;1.42;BSDX;;Sep 29, 2010
    33        ;
    … …  
    77    ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
    88    ;   thanks to Rick Marshall and Zach Gonzalez at Oroville.
    9         ;
    10         ;
     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
    1124APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)    ;EP
    1225        ;Entry point for debugging
    … …  
    1427        Q
    1528        ;
     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,1,"Dr Office",30,"Sam's Note",1)
     67    I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",!
     68    QUIT
     69    ;
    1670APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)     ;EP
    17         ;Called by BSDX ADD NEW APPOINTMENT
    18         ;Add new appointment
    19         ;BSDXRES is ResourceName
     71        ;Called by RPC: BSDX ADD NEW APPOINTMENT
     72        ;
     73    ;Add new appointment to 3 files
     74    ; - BSDX APPOINTMENT
     75    ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
     76    ; - Patient Appointment Subfile if Resource is linked to clinic
     77    ;
     78        ;Paramters:
     79    ;BSDXY: Global Return (RPC must be set to Global Array)
     80    ;BSDXSTART: FM Start Date
     81    ;BSDXEND: FM End Date
     82    ;BSDXPATID: Patient DFN
     83    ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
    2084        ;BSDXLEN is the appointment duration in minutes
     85    ;BSDXNOTE is the Appiontment Note
    2186        ;BSDXATID is used for 2 purposes:
    2287        ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
    2388        ; if BSDXATID = a number, then it is the access type id (used for rebooking)
    2489        ;
    25         ;Create entry in BSDX APPOINTMENT
    26         ;Returns recordset having fields
     90        ;Return:
     91    ; ADO.net Recordset having fields:
    2792        ; AppointmentID and ErrorNumber
    2893        ;
    2994        ;Test lines:
    30     ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^2^PEDIATRICIAN,DEMO^EXAM^SCRATCH NOTE
    31         ;
    32         ;Lock BSDX node
    33         L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI+1,"Another user is working with this patient's record.  Please try again later") Q
    34         ;
     95    ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
     96    ;
     97    ; Return Array; set Return and clear array
     98        S BSDXY=$NA(^BSDXTMP($J))
     99    K ^BSDXTMP($J)
     100    ; $ET
     101        N $ET S $ET="G ETRAP^BSDX07"
     102        ; Counter
     103        N BSDXI S BSDXI=0
     104        ; Lock BSDX node, only to synchronize access to the globals.
     105    ; It's not expected that the error will ever happen as no filing
     106    ; is supposed to take 5 seconds.
     107    L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
     108        ; Header Node
     109    S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00020ERRORID"_$C(30)
    35110    ;Restartable Transaction; restore paramters when starting.
    36     TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID):T="BSDX ADD NEW APPOINTMENT^BSDX07"
    37     ;
    38         N BSDXERR,BSDXIEN,BSDXDEP,BSDXI,BSDXJ,BSDXAPPTI,BSDXDJ,BSDXRESD,BSDXRNOD,BSDXSCD,BSDXC,BSDXERR,BSDXWKIN
     111    ; (Params restored are what's passed here + BSDXI)
     112    TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07"
     113    ;
     114    ; Turn off SDAM APPT PROTOCOL BSDX Entries
    39115        N BSDXNOEV
    40116        S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
    41         K ^BSDXTMP($J)
    42         S X="ETRAP^BSDX07",@^%ZOSF("TRAP")
    43         S BSDXERR=0
    44         S BSDXI=0
    45         S BSDXY="^BSDXTMP("_$J_")"
    46         S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00020ERRORID"_$C(30)
    47         S BSDXI=BSDXI+1
    48         ; v1.3 - date passed in as FM Date, not US date.
    49         ;Check input data for errors
    50         ; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
    51         ; S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
    52         ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
    53         ; I BSDXSTART=-1 D ERR(BSDXI+1,"BSDX07 Error: Invalid Start Time") Q
    54         ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
    55         ; I BSDXEND=-1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q
    56            ;
    57            ; If C# sends the dates with extra zeros, remove them
     117        ;
     118    ; Set Error Message to be empty
     119    N BSDXERR S BSDXERR=0
     120        ;
     121    ;;;test for error inside transaction. See if %ZTER works
     122    I $G(bsdxdie) S X=1/0
     123    ;;;test
     124    ;;;test for TRESTART
     125    I $G(bsdxrestart) K bsdxrestart TRESTART
     126    ;;;test
     127    ;
     128    ; -- Start and End Date Processing --
     129        ; If C# sends the dates with extra zeros, remove them
    58130        S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
    59            ;
    60            I $L(BSDXEND,".")=1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q
    61         I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
    62         I '+BSDXPATID,'$D(^DPT(BSDXPATID,0)) D ERR(BSDXI+1,"BSDX07 Error: Invalid Patient ID") Q
    63         ;Validate Resource entry
    64         S BSDXERR=0 K BSDXRESD
    65         I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI+1,"BSDX07 Error: Invalid Resource ID") Q
     131        ; Are the dates valid? Must be FM Dates > than 2010
     132    I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
     133    I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
     134    ; If Ending date doesn't have a time, this is an error
     135        I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
     136        ; If the Start Date is greater than the end date, swap dates
     137    N BSDXTMP
     138    I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
     139    ;
     140        ; Check if the patient exists:
     141    ; - DFN valid number?
     142    ; - Valid Patient in file 2?
     143    I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q
     144    I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
     145        ;
     146    ;Validate Resource entry
     147        I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
     148        N BSDXRESD ; Resource IEN
    66149        S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
    67         S BSDXWKIN=0
     150        N BSDXRNOD ; Resouce zero node
     151    S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
     152        I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
     153        ;
     154    ; Walk-in (Unscheduled) Appointment?
     155    N BSDXWKIN S BSDXWKIN=0
    68156        I BSDXATID="WALKIN" S BSDXWKIN=1
     157    ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
    69158        I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
    70159        ;
    71         S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID)
    72         I 'BSDXAPPTID D ERR(BSDXI+1,"BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q
     160    ; Done with all checks, let's make appointment in BSDX APPOINTMENT
     161        N BSDXAPPTID
     162    S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID)
     163        I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q
    73164        I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
    74165        ;
    75         ;Create RPMS Appointment
    76         S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
    77         ;I BSDXRNOD="" D ERR(BSDXI+1,"BSDX07 Error: Unable to add appointment -- invalid Resource entry."),BSDXDEL(BSDXAPPTID) Q
    78         I BSDXRNOD="" D ERR(BSDXI+1,"BSDX07 Error: Unable to add appointment -- invalid Resource entry.") Q
    79         S BSDXSCD=$P(BSDXRNOD,U,4)
    80         ;I +BSDXSCD,$D(^SC(BSDXSCD,0)) D  I +BSDXERR D ERR(BSDXI+1,"BSDX07 Error: Unable to make appointment.  MAKE^BSDAPI returned error code: "_BSDXERR),BSDXDEL(BSDXAPPTID) Q
    81         I +BSDXSCD,$D(^SC(BSDXSCD,0)) D  I +BSDXERR D ERR(BSDXI+1,"BSDX07 Error: Unable to make appointment.  MAKE^BSDAPI returned error code: "_BSDXERR) Q
    82         . S BSDXC("PAT")=BSDXPATID
     166        ; Then Create Subfiles in 2/44 Appointment
     167        N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4)  ; Hosp Location IEN
     168    ; Only if we have a valid Hosp Loc can we make an appointment
     169        I +BSDXSCD,$D(^SC(BSDXSCD,0)) D  I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: ~MAKE^BSDAPI returned error code: "_BSDXERR) Q
     170        . N BSDXC
     171    . S BSDXC("PAT")=BSDXPATID
    83172        . S BSDXC("CLN")=BSDXSCD
    84173        . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
    … …  
    87176        . S BSDXC("LEN")=BSDXLEN
    88177        . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
    89         . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDAPI
     178        . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
    90179        . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
    91180        . S BSDXC("USR")=DUZ
    92181        . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
    93182        . Q:BSDXERR
     183        . ;Update RPMS Clinic availability
    94184        . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)
    95         . ;L
    96185        . Q
    97186        ;
    98         ;Update RPMS Clinic availability
    99187        ;Return Recordset
    100188        TCOMMIT
    … …  
    125213        S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
    126214        S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
    127         ;S BSDXFDA(9002018.4,"+1,",.09)=$G(DT) ;MJL 1/25/2007
    128215        S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
    129216        S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
    130217        S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
    131         K BSDXIEN,BSDXMSG
     218        N BSDXIEN,BSDXMSG
    132219        D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
    133220        S BSDXAPPTID=+$G(BSDXIEN(1))
    … …  
    178265        ;
    179266ERR(BSDXI,BSDXERR)      ;Error processing
    180         D ^%ZTER ;XXX: remove after we figure out the cause of error
    181            S BSDXI=BSDXI+1
     267        S BSDXI=BSDXI+1
    182268        S BSDXERR=$TR(BSDXERR,"^","~")
    183         TROLLBACK
     269        I $TL>0 TROLLBACK
    184270        S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
    185271        S BSDXI=BSDXI+1
    186272        S ^BSDXTMP($J,BSDXI)=$C(31)
    187         L
     273        L -^BSDXAPPT(BSDXPATID)
    188274        Q
    189275        ;
    190276ETRAP   ;EP Error trap entry
    191         D ^%ZTER
    192         I '$D(BSDXI) N BSDXI S BSDXI=999999
    193         S BSDXI=BSDXI+1
    194         D ERR(BSDXI,"BSDX07 Error: "_$G(%ZTERROR))
     277        N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
     278    ; Rollback, otherwise ^XTER will be empty from future rollback
     279    I $TL>0 TROLLBACK
     280    D ^%ZTER
     281    S $EC=""  ; Clear Error
     282        ; Log error message and send to client
     283    I '$D(BSDXI) N BSDXI S BSDXI=0
     284        D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
    195285        Q
    196286        ;
Note: See TracChangeset for help on using the changeset viewer.