Changeset 1461


Ignore:
Timestamp:
Jun 26, 2012, 8:01:30 PM (12 years ago)
Author:
Sam Habiel
Message:

Refactoring cont.
Many changes in BSDX08. Extensive changes in BSDX31. Creation of BSDXAPI1 as continuation of BSDXAPI.
BSDXUT1 now has UTs for BSDX31. Transactions now gone from BSDX08 and BSDX31.
BSDX08 needs more tests at failure points. BSDX31 still needs analysis for transaction failure and
code for rollback points, plus tests for that.

Location:
Scheduling/trunk/m
Files:
1 added
5 edited

Legend:

Unmodified
Added
Removed

  • Scheduling/trunk/m/BSDX08.m

    r1460 r1461  
    1 BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/25/12 6:17pm
     1BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/26/12 10:49am
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ;
    … …  
    66        ; Change History
    77        ; 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.
     8        ;  - Transaction work. As of v 1.7, all work here has been superceded
     9        ;  - Refactoring of AVUPDT - never tested though.
    1610        ;  - Refactored all of APPDEL.
    1711        ;
    … …  
    1913        ;  - Added ability to remove checked in appointments. Added a couple
    2014        ;    of units tests for that under UT2.
    21         ;  - Minor reformatting because of how KIDS adds tabs.
     15        ;
     16        ; 3120625 VEN/SMH v1.7
     17        ;  - Transactions removed. Code refactored to work w/o txns.
    2218        ;
    2319        ; Error Reference:
    … …  
    3127        ;  -8^BSDX08: Unable to find associated PIMS appointment for this patient
    3228        ;  -9^BSDX08: BSDXAPI returned an error: (error)
     29        ;  -10^BSDX08: $$BSDXCAN failed (Fileman filing error)
    3330        ;  -100~BSDX08 Error: (Mumps Error)
    3431        ;
    … …  
    7673        ;
    7774        ;;;test for error inside transaction. See if %ZTER works
    78         I $G(BSDXDIE) S X=1/0
     75        I $G(BSDXDIE1) N X S X=1/0
    7976        ;
    8077        ; Check appointment ID and whether it exists
    … …  
    9087        ; Check the resource ID and whether it exists
    9188        N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
    92         ; If the resouce id doesn't exist...
     89        ; If the resource id doesn't exist...
    9390        I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT
    9491        I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
    9592        ;
    96         ; BSDXAPPT First; todo: check for error
    97         D BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
    98         ;
    99         ; Process PIMS issues second:
    100         ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
     93        ;
     94        ; Check if PIMS will let us cancel the appointment using $$CANCELCK^BSDXAPI
    10195        ; Get zero node of resouce
    10296        N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0)
    10397        ; Get Hosp location
    10498        N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4)
    105         ; Error indicator for Hosp Location filing for getting out of routine
     99        ; Error indicator
    106100        N BSDXERR S BSDXERR=0
    107         ; For BSDXC
    108         N BSDXC
    109         ; Only file in 2/44 if there is an associated hospital location
    110         I BSDXLOC D  QUIT:BSDXERR
     101        ;
     102        N BSDXC ; Array to pass to BSDXAPI
     103        ;
     104        I BSDXLOC D
    111105        . S BSDXC("PAT")=BSDXPATID
    112106        . S BSDXC("CLN")=BSDXLOC
    … …  
    120114        . ;
    121115        . S BSDXERR=$$CANCELCK^BSDXAPI(.BSDXC) ; 0 or 1^error message
    122         . I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)) QUIT
     116        ; If error, quit. No need to rollback as no changes took place.
     117        I BSDXERR D ERR(BSDXI,"-9~BSDX08: BSDXAPI reports that "_$P(BSDXERR,U,2)) QUIT
     118        ;
     119        I $G(BSDXDIE2) N X S X=1/0
     120        ;
     121        ; Now cancel the appointment for real
     122        ; BSDXAPPT First; no need for rollback if error occured.
     123        N BSDXERR S BSDXERR=$$BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
     124        I BSDXERR D ERR(BSDXI,"$$BSDXCAN failed (Fileman filing error): "_$P(BSDXERR,U,2)) QUIT
     125        ;
     126        ; Then PIMS:
     127        ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
     128        ; If error happens, must rollback ^BSDXAPPT
     129        I BSDXLOC D  QUIT:BSDXERR
     130        . N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) ; appt length
     131        . S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI
     132        . ; Rollback BSDXAPPT if error occurs
     133        . ; TODO: If an M error occurs in BSDXAPI, ETRAP gets called, ^BSDXTMP is
     134        . ;       populated, then the output of $$CANCEL is the output of ETRAP.
     135        . ;       Then, we see that BSDXERR is true, and we do another write,
     136        . ;       which deletes the information we had in ^BSDXTMP. What to do???
     137        . I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID)  QUIT
    123138        . ;
    124         . N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART)
    125         . ;
    126         . ; Cancel through BSDXAPI
    127         . S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC)
    128         . I BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT
    129         . ; Update Legacy PIMS clinic Availability
     139        . ; Update Legacy PIMS clinic Availability ; no failure expected here.
    130140        . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
    131141        ;
    … …  
    138148        Q
    139149        ;
    140 ROLLBACK(BSDXAPTID)
    141150AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)       ;Update Legacy PIMS Clinic availability
    142151        ;See SDCNP0
    … …  
    185194        Q
    186195        ;
    187 BSDXCAN(BSDXAPTID)      ;
    188         ;Cancel BSDX APPOINTMENT entry
    189         N %DT,X,BSDXDATE,Y,BSDXIENS,BSDXFDA,BSDXMSG
    190         S %DT="XT",X="NOW" D ^%DT ; X ^DD("DD")
    191         S BSDXDATE=Y
     196BSDXCAN(BSDXAPTID)      ; $$; Private; Cancel BSDX APPOINTMENT entry
     197        ; Input: Appt IEN in ^BSDXAPPT
     198        ; Output: 0 for success and 1^Msg for failure
     199        N BSDXDATE,BSDXIENS,BSDXFDA,BSDXMSG
     200        S BSDXDATE=$$NOW^XLFDT()
    192201        S BSDXIENS=BSDXAPTID_","
    193202        S BSDXFDA(9002018.4,BSDXIENS,.12)=BSDXDATE
    194         K BSDXMSG
    195203        D FILE^DIE("","BSDXFDA","BSDXMSG")
    196         Q
     204        I $D(BSDXMSG) Q 1_U_BSDXMSG("DIERR",1,"TEXT",1)
     205        QUIT 0
     206        ;
     207ROLLBACK(BSDXAPTID)  ; Proc; Private; Rollback cancellation
     208        ; Input same as $$BSDXCAN
     209        N BSDXIENS S BSDXIENS=BSDXAPTID_","
     210        N BSDXFDA S BSDXFDA(9002018.4,BSDXIENS,.12)="@"
     211        N BSDXMSG
     212        D FILE^DIE("","BSDXFDA","BSDXMSG")
     213        ;I $D(BSDXMSG)  ; Not sure what to do. We are already handling an error.
     214        QUIT
    197215        ;
    198216CANEVT(BSDXPAT,BSDXSTART,BSDXSC)        ;EP Called by BSDX CANCEL APPOINTMENT event
    … …  
    248266        D ^%ZTER
    249267        S $EC=""  ; Clear Error
     268        ; Roll back BSDXAPPT;
     269        ; TODO: What if a Mumps error happens in fileman in BSDXAPI? The Scheduling files can potentially be out of sync
     270        D:$G(BSDXAPTID) ROLLBACK(BSDXAPTID)
    250271        ; Log error message and send to client
    251272        I '$D(BSDXI) N BSDXI S BSDXI=0
    252273        D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))
    253         QUIT
     274        Q:$Q 1_U_"-100~Mumps Error" Q
    254275        ;
    255276        ;;;NB: This is code that is unused in both original and port.

  • Scheduling/trunk/m/BSDX31.m

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

  • Scheduling/trunk/m/BSDXAPI.m

    r1460 r1461  
    1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/25/12 6:13pm
     1BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/26/12 4:55pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ; Licensed under LGPL 
    … …  
    88        ; Change History:
    99        ; 2010-11-5: (1.42)
    10         ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
    11         ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
     10        ; - Fixed errors having to do uncanceling patient appointments if it was
     11        ;   a patient cancelled appointment.
     12        ; - Use new style Fileman API for storing appointments in file 44 in
     13        ;   $$MAKE due to problems with legacy API.
    1214        ; 2010-11-12: (1.42)
    13         ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well.
     15        ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as
     16        ;   well.
    1417        ; 2010-12-5 (1.42)
    1518        ; Added an entry point to update the patient note in file 44.
    … …  
    3740        ; that the appointment is okay to make before committing to make it. We
    3841        ; still have the provision to delete the data though if we fail when we
    39         ; actually make the appointment
     42        ; actually make the appointment.
     43        ; CANCELCK exists for the same purpose.
    4044        ;
    4145MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO)       ; Simplified PEP w/ parameters for $$MAKE - making appointment
    … …  
    307311        ; remember before status
    308312        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL,SDMODE
     313        NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    309314        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
    310315        S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
    … …  
    318323        S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
    319324        ;
    320         ; update file 2 info --old code
     325        ; update file 2 info --old code; keep for reference
    321326        ;NEW DIE,DA,DR
    322327        ;S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT

  • Scheduling/trunk/m/BSDXUT.m

    r1455 r1461  
    1 BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/22/12 4:27pm
     1BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/26/12 11:06am
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ; Licensed under LGPL
    … …  
    276276        ;
    277277        ; Test 3: Check for -100
    278         N BSDXDIE S BSDXDIE=1
    279         D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
    280         S APPID=+$P(^BSDXTMP($J,1),U)
     278        N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
     279        N APPTTIME S APPTTIME=$P(TIMES,U)
     280        N ENDTIME S ENDTIME=$P(TIMES,U,2)
     281        D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     282        S APPID=+$P(^BSDXTMP($J,1),U)
     283        N BSDXDIE1 S BSDXDIE1=1
    281284        D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
    282285        I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100",!
    283         K BSDXDIE
    284         ;
     286        K BSDXDIE1
     287        ;
     288        ; Test 3.5: Check for -100 with an appointment to rollback.
     289        N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
     290        N APPTTIME S APPTTIME=$P(TIMES,U)
     291        N ENDTIME S ENDTIME=$P(TIMES,U,2)
     292        D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     293        S APPID=+$P(^BSDXTMP($J,1),U)
     294        N BSDXDIE2 S BSDXDIE2=1
     295        D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Reasons")
     296        I $P(^BSDXTMP($J,1),"~")'=-100 W "Error in -100-1",!
     297        I $P(^BSDXAPPT(APPID,0),U,12)'="" W "Error in -100-2",!
     298        K BSDXDIE2
    285299        ; Test 4: Restartable transaction -- retired in V 1.7
    286300        ; Test 5: for invalid Appointment ID (-2 and -3)

  • Scheduling/trunk/m/BSDXUT1.m

    r1460 r1461  
    1 BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/25/12 4:13pm
     1BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/26/12 4:36pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ;
    … …  
    194194        D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
    195195        I +^BSDXTMP($J,1)'=-4 W "Simulated error not triggered",!
    196         I ^BSDXAPPT(APPID,1,1,0)'=ORIGNOTE ZWRITE ^(*) W "ERROR 3",!
     196        I ^BSDXAPPT(APPID,1,1,0)'=ORIGNOTE W "ERROR 3",!
    197197        I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=ORIGNOTE W "ERROR 4",!
    198198        QUIT
     199        ;
     200UT31 ; Unit Tests for BSDX31
     201        ; Set-up - Create Clinics
     202        N RESNAM S RESNAM="UTCLINIC"
     203        N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
     204        D
     205        . N $ET S $ET="D ^%ZTER B"
     206        . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
     207        . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
     208        ;
     209        N HLIEN,RESIEN
     210        S HLIEN=$P(HLRESIENS,U)
     211        S RESIEN=$P(HLRESIENS,U,2)
     212        ;
     213        ; Get start and end times
     214        N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
     215        N APPTTIME S APPTTIME=$P(TIMES,U)
     216        N ENDTIME S ENDTIME=$P(TIMES,U,2)
     217        ;
     218        ; Make appt
     219        N ZZZ,DFN
     220        S DFN=3
     221        D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     222        N APPID S APPID=+$P(^BSDXTMP($J,1),U)
     223        ; Test 1: Sanity Check
     224        D NOSHOW^BSDX31(.ZZZ,APPID,1)
     225        I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",!
     226        I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="N" W "ERROR T1",!
     227        ; Test 2: Undo NOSHOW
     228        D NOSHOW^BSDX31(.ZZZ,APPID,0)
     229        I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",!
     230        I $P(^DPT(DFN,"S",APPTTIME,0),U,2)'="" W "ERROR T2",!
     231        ; Test 3: -1
     232        D NOSHOW^BSDX31(.ZZZ,"",0)
     233        I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",!
     234        ; Test 4: -2
     235        D NOSHOW^BSDX31(.ZZZ,2938748233,0)
     236        I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",!
     237        ; Test 5: -3
     238        D NOSHOW^BSDX31(.ZZZ,APPID,3)
     239        I $P(^BSDXTMP($J,1),U)'=-3 W "ERROR T5",!
     240        ; Test 6: Mumps error (-100)
     241        N BSDXDIE S BSDXDIE=1
     242        D NOSHOW^BSDX31(.ZZZ,APPID,1)
     243        I $P(^BSDXTMP($J,1),U)'=-100 W "ERROR T6",!
     244        K BSDXDIE
     245        ; Test 7: Restartable transaction
     246        N BSDXRESTART S BSDXRESTART=1
     247        D NOSHOW^BSDX31(.ZZZ,APPID,1)
     248        I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T7",!
     249        QUIT
Note: See TracChangeset for help on using the changeset viewer.