Changeset 1460 for Scheduling/trunk/m


Ignore:
Timestamp:
Jun 25, 2012, 8:54:59 PM (13 years ago)
Author:
Sam Habiel
Message:

refactored BSDX26; still working on BSDX08

Location:
Scheduling/trunk/m
Files:
4 edited

Legend:

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

    r1455 r1460  
    1 BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/22/12 4:19pm
     1BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/25/12 6:17pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ;
     
    9494        I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
    9595        ;
    96         ; Process PIMS issues first:
     96        ; BSDXAPPT First; todo: check for error
     97        D BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
     98        ;
     99        ; Process PIMS issues second:
    97100        ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
    98101        ; Get zero node of resouce
     
    120123        . ;
    121124        . N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART)
    122         . ; DEBUG
    123         . I 'BSDXLEN S $EC=",U1,"
    124         . ; DEBUG
     125        . ;
    125126        . ; Cancel through BSDXAPI
    126127        . S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC)
     
    129130        . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
    130131        ;
    131         D BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
    132132        ;
    133133        L -^BSDXAPPT(BSDXAPTID)
     
    138138        Q
    139139        ;
     140ROLLBACK(BSDXAPTID)
    140141AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)       ;Update Legacy PIMS Clinic availability
    141142        ;See SDCNP0
  • Scheduling/trunk/m/BSDX26.m

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

    r1456 r1460  
    1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/22/12 4:25pm
     1BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/25/12 6:13pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ; Licensed under LGPL 
     
    4444        ; for Baby foxes hallucinations.
    4545        ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
     46        N BSDR
    4647        S BSDR("PAT")=DFN       ;DFN
    4748        S BSDR("CLN")=CLIN      ;Hosp Loc IEN
     
    108109        ;
    109110        ; add appt to file 44. This adds it to the FIRST subfile (Appointment)
    110         N DIC,DA,Y,X,DD,DO,DLAYGO
     111        N DIC,DA,Y,X,DD,DO,DLAYGO,DINUM
    111112        I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
    112113        I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D  I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
     
    202203        ; for appt at Dec 20, 2009 @ 10:11:59
    203204        ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
     205        N BSDR
    204206        S BSDR("PAT")=DFN          ;DFN
    205207        S BSDR("CLN")=CLIN         ;Hosp Loc IEN
     
    238240        ;
    239241        ; remember before status
    240         NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
     242        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
    241243        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
    242244        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
     
    264266        ; because foxes come out during bad weather.
    265267        ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
     268        N BSDR
    266269        S BSDR("PAT")=DFN
    267270        S BSDR("CLN")=CLIN
     
    292295        ;   = 1^message:  error and reason
    293296        ;
     297        ; Okay to Cancel? Call Cancel Check.
    294298        N BSDXCANCK S BSDXCANCK=$$CANCELCK(.BSDR)
    295299        I BSDXCANCK Q BSDXCANCK
     
    297301        ; BSDX 1.5 3110125
    298302        ; UJO/SMH - Add ability to remove check-in if the patient is checked in
    299         ; I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
    300         ; Remove check-in if the patient is checked in.
    301         N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure
    302         NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    303         I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    304         I BSDXRESULT Q BSDXRESULT
    305         ; NB: Failure point 1: we fail here nothing has happened yet
     303        ; VEN/SMH on 3120625/v1.7 - PIMS doesn't care if patient is already checked in
     304        ; Lets you remove appointment anyways! Not like RPMS.
     305        ; Plus... deleting checkin affects S node on 44, which is DELETED anyways!
    306306        ;
    307307        ; remember before status
    308         NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
     308        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL,SDMODE
    309309        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
    310310        S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
    311311        D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
    312         ; NB: Here only globals are set. Nothing else.
     312        ; NB: Here only ^TMP globals are set with before values.
    313313        ;
    314314        ; get user who made appt and date appt made from ^SC
     
    318318        S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
    319319        ;
    320         ; update file 2 info
    321         NEW DIE,DA,DR
    322         S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
    323         S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
    324         S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
    325         D ^DIE
    326         ; Failure point 2: If we fail here, it means that the check-in was removed;
    327         ; but the appointment wasn't cancelled.
    328         ; To roll back, we should restore the check-in. However, I would rather not
    329         ; do that. This code will only fail if there's something wrong in the DB.
    330         ; (deleted field for example). If I try to restore the check-in, I just
    331         ; may excercerbate the problem.
    332         ;
    333         ; delete data in ^SC
     320        ; update file 2 info --old code
     321        ;NEW DIE,DA,DR
     322        ;S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
     323        ;S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
     324        ;S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
     325        ;D ^DIE
     326        N BSDXIENS S BSDXIENS=SDT_","_DFN_","
     327        N BSDXFDA
     328        S BSDXFDA(2.98,BSDXIENS,3)=BSDR("TYP")
     329        S BSDXFDA(2.98,BSDXIENS,14)=BSDR("USR")
     330        S BSDXFDA(2.98,BSDXIENS,15)=BSDR("CDT")
     331        S BSDXFDA(2.98,BSDXIENS,16)=BSDR("CR")
     332        S BSDXFDA(2.98,BSDXIENS,19)=USER
     333        S BSDXFDA(2.98,BSDXIENS,20)=DATE
     334        S:$G(BSDR("NOT"))]"" BSDXFDA(2.98,BSDXIENS,17)=$E(BSDR("NOT"),1,160)
     335        N BSDXERR
     336        D FILE^DIE("","BSDXFDA","BSDXERR")
     337        I $D(BSDXERR) Q 1_U_"Cannot cancel appointment in File 2"
     338        ; Failure point 1: If we fail here, nothing has happened yet.
     339        ; No rollback needed in ^BSDXAPPT
     340        ;
     341        ; delete data in ^SC -- this does not (typically) fail. Fileman won't stop
    334342        NEW DIK,DA
    335343        S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
    336344        S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
    337345        D ^DIK
    338         ; Failure point 3: If we fail here, we need to restore the cancel date,
    339         ; and possibly, the check-in.
    340         ;
    341         ; call event driver
     346        ; Failure point 2: not expected to happen here
     347        ;
     348        ; call event driver -- point of no return
    342349        D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
    343350        Q 0
     
    378385        ;
    379386        ; Move my variables into the ones used by SDAPIs (just a convenience)
    380         NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
     387        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
    381388        S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT)
    382389        ;
     
    389396        ; remove check-in using filer.
    390397        N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
     398        N BSDXFDA
    391399        S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN
    392400        S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER
     
    397405        ;
    398406        ; set after status
    399         S SDDA=$$SCIEN(DFN,SDCL,SDT)
     407        ; S SDDA=$$SCIEN(DFN,SDCL,SDT) ;smh -why is this here? SDDA won't change.
    400408        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
    401409        D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
     
    437445        ; 0 if okay
    438446        ; -1 if failure
     447        ;
     448        ; ERROR SIMULATION
     449        I $G(BSDXSIMERR1) QUIT "-1~Simulated Error"
     450        ;
    439451        N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
    440452        I SCIEN<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
    441453        N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
    442         S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
     454        N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
    443455        N BSDXERR
    444456        D FILE^DIE("","BSDXFDA","BSDXERR")
  • Scheduling/trunk/m/BSDXUT1.m

    r1455 r1460  
    1 BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/22/12 1:44pm
     1BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/25/12 4:13pm
    22        ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
    33        ;
     
    8686        W "Last line should say 0",!
    8787        QUIT
     88        ;
     89UT26    ; Unit Tests - BSDX26
     90        ;
     91        ; Test 1: Make sure this damn thing works
     92        ; Set-up - Create Clinics
     93        N RESNAM S RESNAM="UTCLINIC"
     94        N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
     95        D
     96        . N $ET S $ET="D ^%ZTER B"
     97        . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
     98        . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
     99        ;
     100        N HLIEN,RESIEN
     101        S HLIEN=$P(HLRESIENS,U)
     102        S RESIEN=$P(HLRESIENS,U,2)
     103        ;
     104        ; Get start and end times
     105        N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
     106        N APPTTIME S APPTTIME=$P(TIMES,U)
     107        N ENDTIME S ENDTIME=$P(TIMES,U,2)
     108        ;
     109        ; Make appt
     110        N ZZZ,DFN
     111        S DFN=3
     112        D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     113        N APPID S APPID=+$P(^BSDXTMP($J,1),U)
     114        ;
     115        ; Now edit the note - basic test
     116        N %H S %H=$H
     117        N NOTE S NOTE="New Note "_%H
     118        D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
     119        I ^BSDXAPPT(APPID,1,1,0)'=NOTE W "ERROR 1",!
     120        I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=NOTE W "Error in HL Section",!
     121        ;
     122        ; Test 2: Test Error -1
     123        ; -1 --> ApptID not a number
     124        N ZZZ
     125        N NOTE S NOTE="Nothing important"
     126        D EDITAPT^BSDX26(.ZZZ,"BLAHBLAH",NOTE)
     127        I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",!
     128        ;
     129        ; Test 3: Test Error -2
     130        ; -2 --> ApptID not in ^BSDXAPPT
     131        D EDITAPT^BSDX26(.ZZZ,298734322,NOTE)
     132        I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",!
     133        ;
     134        ; Test 4: M Error
     135        N BSDXDIE S BSDXDIE=1
     136        D EDITAPT^BSDX26(.ZZZ,188,NOTE)
     137        I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",!
     138        K BSDXDIE
     139        ; Test 5: Trestart -- retired in v1.7
     140        ;
     141        ; Test 6: UTs for an unlinked resource (not linked to PIMS)
     142        N RESNAM S RESNAM="UTCLINICUL" ; Unlinked Clinic
     143        N RESIEN
     144        D
     145        . N $ET S $ET="D ^%ZTER B"
     146        . S RESIEN=$$UTCRRES^BSDXUT(RESNAM)
     147        . I RESIEN<0 S $EC=",U1," ; not supposed to happen - hard crash if so
     148        ;
     149        ; Get start and end times
     150        N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
     151        N APPTTIME S APPTTIME=$P(TIMES,U)
     152        N ENDTIME S ENDTIME=$P(TIMES,U,2)
     153        ;
     154        N ZZZ,DFN
     155        S DFN=3
     156        D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
     157        N APPID S APPID=+$P(^BSDXTMP($J,1),U)
     158        ; Now edit the note - basic test
     159        N %H S %H=$H
     160        N NOTE S NOTE="New Note "_%H
     161        D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
     162        I ^BSDXAPPT(APPID,1,1,0)'=NOTE W "ERROR 2",!
     163        ;
     164        ; Test 7: Simulated failure in BSDXAPI
     165        N RESNAM S RESNAM="UTCLINIC"
     166        N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
     167        D
     168        . N $ET S $ET="D ^%ZTER B"
     169        . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
     170        . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
     171        ;
     172        N HLIEN,RESIEN
     173        S HLIEN=$P(HLRESIENS,U)
     174        S RESIEN=$P(HLRESIENS,U,2)
     175        ;
     176        ; Get start and end times
     177        N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
     178        N APPTTIME S APPTTIME=$P(TIMES,U)
     179        N ENDTIME S ENDTIME=$P(TIMES,U,2)
     180        ;
     181        ; Make appt
     182        N ZZZ,DFN
     183        S DFN=3
     184        N ORIGNOTE S ORIGNOTE="Sam's Note"
     185        D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,ORIGNOTE,1)
     186        N APPID S APPID=+$P(^BSDXTMP($J,1),U)
     187        ;
     188        ; Create the error condition
     189        N BSDXSIMERR1 S BSDXSIMERR1=1
     190        ;
     191        ; Try to edit the note. Should still be "Sam's Note"
     192        N %H S %H=$H
     193        N NOTE S NOTE="New Note "_%H
     194        D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
     195        I +^BSDXTMP($J,1)'=-4 W "Simulated error not triggered",!
     196        I ^BSDXAPPT(APPID,1,1,0)'=ORIGNOTE ZWRITE ^(*) W "ERROR 3",!
     197        I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=ORIGNOTE W "ERROR 4",!
     198        QUIT
Note: See TracChangeset for help on using the changeset viewer.