Changeset 1464 for Scheduling/trunk


Ignore:
Timestamp:
Jun 29, 2012, 7:09:55 PM (12 years ago)
Author:
Sam Habiel
Message:

BSDX25 refactoring, continued

Location:
Scheduling/trunk/m
Files:
6 edited

Legend:

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

    r1463 r1464  
    1 BSDX25  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/28/12 11:45am
    2         ;;1.6;BSDX;;Aug 31, 2011;Build 18
     1BSDX25  ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 6/29/12 12:04pm
     2        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ; Licensed under LGPL
    44        ;
     
    77        ;
    88        ;
    9 CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP
     9CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)        ;EP
    1010        ;Entry point for debugging
    1111        ;
    12         ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
    13         Q
    14         ;
    15 CHECKIN(BSDXY,BSDXAPTID,BSDXCDT) ;Private EP Check in appointment
     12        ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
     13        Q
     14        ;
     15CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
    1616        ; Old additional vars: ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)
     17        ; Called by RPC: BSDX CHECKIN APPOINTMENT
     18        ;
    1719        ; Private to GUI; use BSDXAPI for general API to checkin patients
    1820        ; Parameters:
    1921        ; BSDXY: Global Out
    20         ; BSDXAPTID: Appointment ID in ^BSDXAPPT
     22        ; BSDXAPPTID: Appointment ID in ^BSDXAPPT
    2123        ; BSDXCDT: Checkin Date --> Changed
    2224        ; BSDXCC: Clinic Stop IEN (not used)
     
    2527        ; BSDXVCL: PCC+ Clinic IEN (not used)
    2628        ; BSDXVFM: PCC+ Form IEN (not used)
    27         ; BSDXOG: PCC+ Outguide (true or false)
     29        ; BSDXOG: PCC+ Outguide (true or false) (not used)
    2830        ;
    2931        ; Output:
     
    3234        ; - Another number or text if not
    3335        ;
    34         N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXZ,BSDXIENS,BSDXVEN
    35         ;
    3636        ; Turn off SDAM Appointment Events BSDX Protocol Processing
    3737        N BSDXNOEV
     
    3939        ;
    4040        ; Set min DUZ vars
    41         D ^XBKVAR 
     41        D ^XBKVAR
    4242        ;
    4343        ; $ET
     
    4545        ;
    4646        N BSDXI S BSDXI=0
    47         K ^BSDXTMP($J)
    48         S BSDXY="^BSDXTMP("_$J_")"
     47        ;
     48        S BSDXY=$NAME(^BSDXTMP($J))
     49        K @BSDXY
     50        ;
    4951        S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
    50         I '+BSDXAPTID D ERR("BSDX25: Invalid Appointment ID") Q
    51         I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("BSDX08: Invalid Appointment ID") Q
     52        ;
     53        I '+BSDXAPPTID D ERR("Invalid Appointment ID") QUIT
     54        I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("Invalid Appointment ID") QUIT
     55        ;
     56        ; Lock the node for synchronizing access to appointment
     57        LOCK +^BSDXAPPT(BSDXAPPTID):1
     58        ELSE  DO ERR("-7~Lock not acquired") QUIT
     59        ;
    5260        ; Remove Date formatting v.1.5. Client will send date as FM Date.
    5361        ;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
     
    5664        I BSDXCDT=-1 D ERR(70) Q
    5765        I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT
     66        ;
    5867        ;Checkin BSDX APPOINTMENT entry
    59         D BSDXCHK(BSDXAPTID,BSDXCDT)
    60         S BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
    61         S BSDXPATID=$P(BSDXNOD,U,5)
    62         S BSDXSTART=$P(BSDXNOD,U)
    63         ;
    64         S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
    65         I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D  I +$G(BSDXZ) D ERR($P(BSDXZ,U,2)) Q
    66         . S BSDXNOD=^BSDXRES(BSDXSC1,0)
    67         . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
    68         . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APCHK(.BSDXZ,BSDXSC1,BSDXPATID,BSDXCDT,BSDXSTART)
     68        N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,BSDXCDT)
     69        I BSDXERR D ERR("BSDX08: Fileman Filer failed to check-in appt") QUIT
     70        ;
     71        N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
     72        N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5)
     73        N BSDXSTART S BSDXSTART=$P(BSDXNOD,U)
     74        ;
     75        ; Get Hospital Location IEN from BSDXAPPT to BSDXRES (RESOUCE:HOSPITAL LOCATION)
     76        N BSDXSC1 S BSDXSC1=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",".07:.04","I")
     77        I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Null it off if it doesn't exist
     78        ;
     79        ; File check-in using BSDXAPI
     80        N BSDXERR S BSDXERR=0
     81        I BSDXSC1 S BSDXERR=$$CHECKIN1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART)
     82        I BSDXERR D ERR($P(BSDXZ,U,2)) QUIT
     83        ;
     84        ; Unlock
     85        LOCK -^BSDXAPPT(BSDXAPPTID)
    6986        ;
    7087        S BSDXI=BSDXI+1
     
    7491        Q
    7592        ;
    76 BSDXCHK(BSDXAPTID,BSDXCDT)      ;
    77         ;
    78         S BSDXIENS=BSDXAPTID_","
     93BSDXCHK(BSDXAPPTID,BSDXCDT)     ; $$ Private Entry Point. File or delete check-in to
     94        ; BSDX Appointment
     95        ; Input: BSDXAPPTID -> Appointment ID
     96        ;        BSDXCDT -> Check-in date, or "@" to remove check-in.
     97        ;
     98        ; Output: 1^Error for error
     99        ;         0 for success
     100        ;
     101        N BSDXIENS,BSDXMSG,BSDXFDA ; Filer variables
     102        S BSDXIENS=BSDXAPPTID_","
    79103        S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
    80104        D FILE^DIE("","BSDXFDA","BSDXMSG")
    81         Q
    82         ;
    83 APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART)          ;
    84         ;Checkin appointment for patient BSDXDFN in clinic BSDXSC1
    85         ;at time BSDXSTART
    86         S BSDXZ=$$CHECKIN1^BSDXAPI(BSDXDFN,BSDXSC1,BSDXSTART)
    87         Q
     105        Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1)
     106        Q 0
    88107        ;
    89108RMCI(BSDXY,BSDXAPPTID)  ; EP - Remove Check-in from BSDX APPT and 2/44
    90         ; Called by RPC [Fill in later]
     109        ; Called by RPC BSDX REMOVE CHECK-IN
    91110        ;
    92111        ; Parameters to pass:
     
    103122        ; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES)
    104123        ; -5~BSDXAPI Error. Message depends on error.
     124        ; -6~Data Filing Error in BSDXCHK
     125        ; -7~Lock not acquired
    105126        ; -100~Mumps Error
    106127        ;
     
    117138        S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset
    118139        ;
    119         TSTART (BSDXI):SERIAL ; Perform Autolocking
    120         ;
    121140        ;;;test
    122         I $g(bsdxdie) S X=8/0
    123         ;;;
    124         I $g(bsdxrestart) k bsdxrestart TRESTART
    125         ;;;test
     141        I $G(BSDXDIE) N X S X=8/0
    126142        ;
    127143        ; Check for Appointment ID (passed and exists in file)
     
    129145        I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT
    130146        ;
     147        ; Lock the node for synchronizing access to appointment
     148        LOCK +^BSDXAPPT(BSDXAPPTID):1
     149        ELSE  DO ERR("-7~Lock not acquired") QUIT
     150        ;
    131151        ; Remove checkin from BSDX APPOINTMENT entry
    132         D BSDXCHK(BSDXAPPTID,"@")
     152        N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@")
     153        I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT
    133154        ;
    134155        ; Now, remove checkin from PIMS files 2/44
     
    149170        I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT
    150171        ;
    151         TCOMMIT  ; Save Data into Globals
     172        ; Unlock
     173        LOCK -^BSDXAPPT(BSDXAPPTID)
    152174        ;
    153175        ; Return ADO recordset
     
    183205        Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
    184206        S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
    185         . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
     207        . N BSDXNOD S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
    186208        . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
    187         I BSDXFOUND,+$G(BSDXAPPT) D BSDXCHK(BSDXAPPT,BSDXSTAT)
     209        I BSDXFOUND,+$G(BSDXAPPT) D
     210        . N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPT,BSDXSTAT)
     211        . I BSDXERR D ^%ZTER ; VEN/SMH - This is silent. This is a last resort
    188212        Q BSDXFOUND
    189213        ;
     
    200224ERROR   ;
    201225        S $ETRAP="D ^%ZTER HALT"  ; Emergency Error Trap for the wise
    202         ; Rollback, otherwise ^XTER will be empty from future rollback
    203         I $TL>0 TROLLBACK
    204226        D ^%ZTER
    205227        S $EC=""  ; Clear Error
     
    209231        ;
    210232ERR(BSDXERR)    ;Error processing
    211         I $TLEVEL>0 TROLLBACK
     233        I $G(BSDXAPPTID) LOCK -^BSDXAPPT(BSDXAPPTID)
    212234        S BSDXERR=$G(BSDXERR)
    213235        S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name
  • Scheduling/trunk/m/BSDXAPI.m

    r1461 r1464  
    1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/26/12 4:55pm
     1BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/29/12 12:19pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ; Licensed under LGPL 
  • Scheduling/trunk/m/BSDXAPI1.m

    r1462 r1464  
    1 BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 6/27/12 4:45pm
     1BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 6/29/12 11:52am
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ; Licensed under LGPL 
     
    5656        ; Q:'$$CHK ; Checks $D(^SD(409.63,"ANS",1,+SDSTB))
    5757        QUIT 0
     58        ;
     59RMCI(PAT,CLINIC,DATE)    ;PEP; -- Remove Check-in; $$
     60        ; PAT = DFN
     61        ; CLINIC = SC IEN
     62        ; DATE = FM Date/Time of Appointment
     63        ;
     64        ; Returns:
     65        ; 0 if okay
     66        ; -1 if failure
     67        ;
     68        ; Call like this: $$RMCI(233,33,3110102.1130)
     69        ;
     70        ; Move my variables into the ones used by SDAPIs (just a convenience)
     71        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
     72        S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN^BSDXAPI(DFN,SDCL,SDT)
     73        ;
     74        I SDDA<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
     75        ;
     76        ; remember before status
     77        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
     78        D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
     79        ;
     80        ; remove check-in using filer.
     81        N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
     82        N BSDXFDA
     83        S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN
     84        S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER
     85        S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED
     86        N BSDXERR
     87        D FILE^DIE("","BSDXFDA","BSDXERR")
     88        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)
     89        ;
     90        ; set after status
     91        ; S SDDA=$$SCIEN(DFN,SDCL,SDT) ;smh -why is this here? SDDA won't change.
     92        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
     93        D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
     94        ;
     95        ; call event driver
     96        D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
     97        QUIT 0
     98        ;
     99UPDATENT(PAT,CLINIC,DATE,NOTE)  ; PEP; Update Note in ^SC for patient's appointment @ DATE
     100        ; PAT = DFN
     101        ; CLINIC = SC IEN
     102        ; DATE = FM Date/Time of Appointment
     103        ;
     104        ; Returns:
     105        ; 0 if okay
     106        ; -1 if failure
     107        ;
     108        ; ERROR SIMULATION
     109        I $G(BSDXSIMERR1) QUIT "-1~Simulated Error"
     110        ;
     111        N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE) ; ien of appt in ^SC
     112        I SCIEN<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
     113        N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
     114        N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
     115        N BSDXERR
     116        D FILE^DIE("","BSDXFDA","BSDXERR")
     117        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)
     118        QUIT 0
     119        ;
  • Scheduling/trunk/m/BSDXUT.m

    r1463 r1464  
    1 BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/28/12 10:14am
     1BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/29/12 12:20pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ; Licensed under LGPL
     
    66        ; June 21 2012: Initial Version
    77        ;
     8EN      ; Run all Unit Tests
     9        D UT07
     10        QUIT
    811UT07    ; Unit Tests for BSDX07 - Assumes you have Patients with DFNs 1,2,3,4,5
    912        ; HLs/Resources are created as part of the UT
  • Scheduling/trunk/m/BSDXUT1.m

    r1463 r1464  
    1 BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/28/12 10:17am
     1BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/29/12 12:32pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ;
     4        ;
     5EN      ; Run All Unit Tests in this routine
     6        D UT08,UT29,UT26,UT31
     7        QUIT
    48        ;
    59UT08    ; Unit Tests for BSDX08; Must have patients 1,2,3,4,5 defined in system
     
    221225        ;
    222226        W "Waiting for 5 seconds for it to finish",! HANG 5
    223         W ^BSDXTMP("BSDXCOPY",+^BSDXTMP($J,1)),!
    224         W "Last line should say 0",!
     227        W:^BSDXTMP("BSDXCOPY",+^BSDXTMP($J,1))'["  0 records" "Copy failed",!
    225228        QUIT
    226229        ;
  • Scheduling/trunk/m/BSDXUT2.m

    r1463 r1464  
    1 BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/28/12 11:55am
     1BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/29/12 12:23pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
     3        ;
     4EN      ; Run all unit tests in this routine
     5        D UT25
     6        QUIT
    37        ;
    48UT25 ; Unit Tests for BSDX25
     
    4650        ; Tests for 3 to 5 difficult to produce
    4751        ; Error tests follow: Mumps error test; Transaction restartability
    48         N bsdxdie S bsdxdie=1
     52        N BSDXDIE S BSDXDIE=1
    4953        D RMCI^BSDX25(.ZZZ,APPTID)
    5054        IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 3",!
    51         K bsdxdie
    52         N bsdxrestart S bsdxrestart=1
    53         D RMCI^BSDX25(.ZZZ,APPTID)
    54         IF +^BSDXTMP($J,1)'=0 WRITE "Error in Etest 4",!
     55        K BSDXDIE
    5556        ;
    5657        ; Unlinked Clinic Tests
     
    9192        ; Tests for 3 to 5 difficult to produce
    9293        ; Error tests follow: Mumps error test; Transaction restartability
    93         N bsdxdie S bsdxdie=1
     94        N BSDXDIE S BSDXDIE=1
    9495        D RMCI^BSDX25(.ZZZ,APPTID)
    9596        IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 7",!
    96         K bsdxdie
    97         N bsdxrestart S bsdxrestart=1
    98         D RMCI^BSDX25(.ZZZ,APPTID)
    99         IF +^BSDXTMP($J,1)'=0 WRITE "Error in Etest 8",!
     97        K BSDXDIE
    10098        ;
    10199        ; Tests for running PIMS by itself.
     
    113111        IF '+$G(^SC(HLIEN,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 10",!
    114112        IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 11",!
    115         N % S %=$$RMCI^BSDXAPI(DFN,HLIEN,APPTTIME)
     113        N % S %=$$RMCI^BSDXAPI1(DFN,HLIEN,APPTTIME)
    116114        I % W "Error removing Check-in via PIMS",!
    117115        I +$G(^SC(HLIEN,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 12",!
Note: See TracChangeset for help on using the changeset viewer.