Changeset 1452 for Scheduling/trunk


Ignore:
Timestamp:
Jun 20, 2012, 7:42:19 PM (12 years ago)
Author:
Sam Habiel
Message:

done with BSDX07

Location:
Scheduling/trunk/m
Files:
4 edited

Legend:

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

    r1451 r1452  
    1 BSDX07  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS  ; 6/19/12 5:34pm
     1BSDX07  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS  ; 6/20/12 3:28pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ; Licensed under LGPL
     
    1212        ;      It could be midnight of the next day
    1313        ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
     14        ; v1.7 Jun 20 2012 - Refactoring to remove transactions - many changes
    1415        ;
    1516        ; Error Reference:
     
    3839        . N $ET S $ET="D ^%ZTER B"
    3940        . S HLRESIENS=$$UTCR^BSDX35(RESNAM)
    40         . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen
     41        . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
    4142        ;
    4243        N HLIEN,RESIEN
     
    8485        S BSDX("CLN")=HLIEN
    8586        S BSDX("ADT")=APPTTIME
    86         D BSDXDEL^BSDX07(APPID)
    87         S %=$$UNMAKE^BSDXAPI(.BSDX)
     87        D ROLLBACK(APPID,.BSDX)
    8888        I +$G(^BSDXAPPT(APPID,0)) W "Error in deleting appointment-1",!
    8989        I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-2",!
    9090        I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-3",!
    9191        ;
     92        ; Again for a different patient (5)
     93        S DFN=5
     94        D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     95        N APPID S APPID=+$P(^BSDXTMP($J,1),U)
     96        I 'APPID W "Error Making Appt-13" QUIT
     97        I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-14"
     98        I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-15"
     99        I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-16"
     100        ; Now cancel that appointment
     101        D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
     102        ; Now make it again
     103        D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     104        N APPID S APPID=+$P(^BSDXTMP($J,1),U)
     105        I 'APPID W "Error Making Appt-17" QUIT
     106        I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-18"
     107        I '$D(^DPT(DFN,"S",APPTTIME)) W "Error Making Appt-19"
     108        I '$$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error Making Appt-20"
     109        ;
    92110        ; Delete appointment set for Patient 1 (not made)... needs to not crash
    93111        D
    94112        . N $ET S $ET="D ^%ZTER S $EC="""" W ""Failure to del non-existent appt"",!"
    95         . D BSDXDEL^BSDX07(9999999)
    96113        . N BSDX
    97114        . S BSDX("PAT")=1
    98115        . S BSDX("CLN")=HLIEN
    99116        . S BSDX("ADT")=APPTTIME
    100         . S %=$$UNMAKE^BSDXAPI(.BSDX)
     117        . D ROLLBACK(APPID,.BSDX)
    101118        ;
    102119        ; Test for bad start date
     
    141158        D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1)
    142159        I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",!
     160        ;
     161        ; Test that rollback occurs properly in various places
     162        N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time
     163        N APPTTIME S APPTTIME=$P(TIMES,U)
     164        N ENDTIME S ENDTIME=$P(TIMES,U,2)
     165        S DFN=4
     166        N BSDXSIMERR1 S BSDXSIMERR1=1
     167        D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     168        N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
     169        I +APPID W "Error in deleting appointment-4",!
     170        I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-5",!
     171        I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-6",!
     172        ;
     173        K BSDXSIMERR1
     174        N BSDXSIMERR2 S BSDXSIMERR2=1
     175        D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     176        N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
     177        I +APPID W "Error in deleting appointment-7",!
     178        I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-8",!
     179        I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-9",!
     180        ;
     181        K BSDXSIMERR2
     182        N BSDXSIMERR4 S BSDXSIMERR4=1
     183        D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     184        N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
     185        I +APPID W "Error in deleting appointment-16",!
     186        I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-17",!
     187        I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-18",!
     188        ;
     189        K BSDXSIMERR4
     190        N BSDXSIMERR5 S BSDXSIMERR5=1
     191        D APPADD(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     192        N APPID S APPID=$O(^BSDXAPPT("B",APPTTIME,""))
     193        I +APPID W "Error in deleting appointment-19",!
     194        I $D(^DPT(DFN,"S",APPTTIME)) W "Error in deleting appointment-20",!
     195        I $$SCIEN^BSDXAPI(DFN,HLIEN,APPTTIME) W "Error in deleting appointment-21",!
    143196        QUIT
    144197        ;
     
    168221        ; ADO.net Recordset having fields:
    169222        ; AppointmentID and ErrorNumber
     223        ;
     224        ; NB: Specifying BSDXLEN and BSDXEND is redundant. For future programmers
     225        ; to sort out
    170226        ;
    171227        ;Test lines:
     
    261317        S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
    262318        I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q  ; no roll back needed! No appts made.
    263         I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; TODO: check for error and rollback
     319        I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) ; no error checks are made here
     320        ; I don't think it's important b/c users can detect right away if the WP
     321        ; filing fails.
     322        ;
     323        I $G(BSDXSIMERR1) D ERR(BSDXI,"-11~BSDX07 Error: Simulated Error"),ROLLBACK(BSDXAPPTID,.BSDXC) Q  ; UT Line
    264324        ;
    265325        ; Only if we have a valid Hosp Loc can we make an appointment in 2/44
     
    269329        . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
    270330        . Q:BSDXERR
    271         . ;Update RPMS Clinic availability
    272         . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)
     331        . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ; Update RPMS Clinic availability
    273332        ;
    274333        ;Return Recordset
     
    346405        Q
    347406        ;
    348 ERR(BSDXI,BSDXERR)       ;Error processing
     407ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set
     408        ; DO NOT USE except as an emergency measure - only if unforseen error occurs
     409        ; Input:
     410        ; Appointment ID to remove from ^BSDXAPPT
     411        ; BSDXC array (see array format in $$MAKE^BSDXAPI)
     412        ; NB: I am not sure whether I want to do $G to protect??
     413        ; I send the variables to this EP from the Symbol Table in ETRAP
     414        D BSDXDEL^BSDX07(BSDXAPPTID)
     415        S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0
     416        QUIT
     417        ;
     418BSDXDEL(BSDXAPPTID)     ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT
     419        ; DO NOT USE except in emergencies to roll back an appointment set
     420        N DA,DIK
     421        S DIK="^BSDXAPPT(",DA=BSDXAPPTID
     422        D ^DIK
     423        Q
     424        ;
     425ERR(BSDXI,BSDXERR)       ;Error processing - different from error trap.
    349426        S BSDXI=BSDXI+1
    350427        S BSDXERR=$TR(BSDXERR,"^","~")
     
    355432        Q
    356433        ;
    357 ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set
    358         ; DO NOT USE except as an emergency measure - only if unforseen error occurs
    359         ; Input:
    360         ; Appointment ID to remove from ^BSDXAPPT
    361         ; BSDXC array (see array format in $$MAKE^BSDXAPI)
    362         D BSDXDEL^BSDX07(BSDXAPPTID)
    363         S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0
    364         QUIT
    365         ;
    366 BSDXDEL(BSDXAPPTID)     ;Private EP ; Deletes appointment BSDXAPPTID from ^BSDXAPPT
    367         ; DO NOT USE except in emergencies to roll back an appointment set
    368         N DA,DIK
    369         S DIK="^BSDXAPPT(",DA=BSDXAPPTID
    370         D ^DIK
    371         Q
    372         ;
    373434ETRAP     ;EP Error trap entry
    374435        N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
    375436        D ^%ZTER
    376437        S $EC=""  ; Clear Error
     438        I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists
    377439        ; Log error message and send to client
    378440        I '$D(BSDXI) N BSDXI S BSDXI=0
    379441        D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
    380         Q
     442        Q:$Q 1_U_"Mumps Error" Q
    381443        ;
    382444DAY     ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
  • Scheduling/trunk/m/BSDX08.m

    r1187 r1452  
    1 BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am
    2         ;;1.6T2;BSDX;;May 16, 2011
     1BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/20/12 3:52pm
     2        ;;1.6;BSDX;;Aug 31, 2011;Build 18
    33        ;
    44        ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
     
    3535APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
    3636        ;Entry point for debugging
    37         D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")
     37        ;D DEBUG^%Serenji("APPDEL^BSDX08(.BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)")
    3838        Q
    3939        ;
    4040UT      ; Unit Tests
     41        N RESNAM S RESNAM="UTCLINIC"
     42        N HLRESIENS ; holds output of UTCR^BSDX35 - HL IEN^Resource IEN
     43        D
     44        . N $ET S $ET="D ^%ZTER B"
     45        . S HLRESIENS=$$UTCR^BSDX35(RESNAM)
     46        . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
     47        ;
     48        N HLIEN,RESIEN
     49        S HLIEN=$P(HLRESIENS,U)
     50        S RESIEN=$P(HLRESIENS,U,2)
     51        ;
     52        ; Get start and end times
     53        N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time
     54        N APPTTIME S APPTTIME=$P(TIMES,U)
     55        N ENDTIME S ENDTIME=$P(TIMES,U,2)
     56        ;
    4157        ; Test 1: Make normal appointment and cancel it. See if every thing works
    42         N ZZZ
    43         D APPADD^BSDX07(.ZZZ,3110123.2,3110123.3,4,"Dr Office",10,"Sam's Note",1)
     58        N ZZZ,DFN
     59        S DFN=3
     60        D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
    4461        S APPID=+$P(^BSDXTMP($J,1),U)
    4562        D APPDEL^BSDX08(.ZZZ,APPID,"PC",1,"Sam's Cancel Note")
    4663        I $P(^BSDXAPPT(APPID,0),U,12)'>0 W "Error in Cancellation-1"
    47         I $O(^SC(2,"S",3110123.2,1,0))]"" W "Error in Cancellation-2"
    48         I $P(^DPT(4,"S",3110123.2,0),U,2)'="PC" W "Error in Cancellation-3"
     64        I $O(^SC(2,"S",APPTTIME,1,0))]"" W "Error in Cancellation-2"
     65        I $P(^DPT(4,"S",APPTTIME,0),U,2)'="PC" W "Error in Cancellation-3"
    4966        I ^DPT(4,"S",3110123.2,"R")'="Sam's Cancel Note" W "Error in Cancellation-4"
    5067        ;
  • Scheduling/trunk/m/BSDX09.m

    r1187 r1452  
    11BSDX09  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 4/28/11 10:18am
    2         ;;1.6T2;BSDX;;May 16, 2011;Build 7
     2        ;;1.6;BSDX;;Aug 31, 2011;Build 18
    33        ; Licensed under LGPL
    44        ;
  • Scheduling/trunk/m/BSDXAPI.m

    r1451 r1452  
    1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/19/12 5:42pm
     1BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/20/12 12:40pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ; Licensed under LGPL 
    44        ;
    55        ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
    6         ;local mods (many) by WV/SMH
     6        ; mods (many) by WV/SMH
    77        ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
    88        ; Change History:
     
    8787        . S BSDXFDA(2.98,BSDXIENS,"15")=""
    8888        . S BSDXFDA(2.98,BSDXIENS,"16")=""
     89        . S BSDXFDA(2.98,BSDXIENS,"17")="@" ; v 1.7; cancellation remarks were left over
    8990        . S BSDXFDA(2.98,BSDXIENS,"19")=""
    9091        . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
    9192        . D FILE^DIE("","BSDXFDA","BSDXMSG")
    9293        Q:$D(BSDXMSG) 1_U_"Fileman edit to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
     94        ;
     95        Q:$G(BSDXSIMERR2) 1_U_$NA(BSDXSIMERR2) ; Unit Test line
    9396        ;
    9497        E  D  ; File new appointment/edit existing appointment in file 2
     
    102105        Q:$D(BSDXMSG) 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")_" Error="_BSDXMSG("DIERR",1,"TEXT",1)
    103106        ;
     107        Q:$G(BSDXSIMERR3) 1_U_$NA(BSDXSIMERR3) ; Unit Test line
     108        ;
    104109        ; add appt to file 44. This adds it to the FIRST subfile (Appointment)
    105110        N DIC,DA,Y,X,DD,DO,DLAYGO
     
    109114        . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
    110115        . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
     116        ;
     117        Q:$G(BSDXSIMERR4) 1_U_$NA(BSDXSIMERR4) ; Unit Test line
    111118        ;
    112119        ; add appt for file 44, second subfile (Appointment/Patient)
     
    130137        ;
    131138        I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1)
     139        ;
     140        ;Q:$G(BSDXSIMERR5) 1_U_$NA(BSDXSIMERR5) ; Unit Test line
     141        S:$G(BSDXSIMERR5) X=1/0
    132142        ;
    133143        ; call event driver
     
    176186        NEW DIK,DA
    177187        S DIK="^DPT("_BSDR("PAT")_",""S"","
    178         S DA(1)=BSDR("PAT"),DA=BSDX("ADT")
     188        S DA(1)=BSDR("PAT"),DA=BSDR("ADT")
    179189        D ^DIK
    180190        ;
Note: See TracChangeset for help on using the changeset viewer.