Changeset 1036


Ignore:
Timestamp:
Dec 8, 2010, 1:44:40 AM (14 years ago)
Author:
Sam Habiel
Message:

Refactoring and txn restart fix to routines 26,29,31

Location:
Scheduling/trunk/m
Files:
3 edited

Legend:

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

    r1034 r1036  
    1 BSDX26  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 11/18/10 5:36pm
     1BSDX26  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 3:08am
    22    ;;1.42;BSDX;;Sep 29, 2010
    33    ; Change History:
     
    3434    D EDITAPT(.ZZZ,188,NOTE)
    3535    I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B
     36    k bsdxdie
    3637    ; Test 5: Trestart
    3738    N bsdxrestart S bsdxrestart=1
     
    4041    D EDITAPT(.ZZZ,188,NOTE)
    4142    I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B
    42     ; Test for Hosp Location Update
     43    ; Test 6: for Hosp Location Update
    4344    N DATE S DATE=$$NOW^XLFDT()
     45    S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
    4446    D APPADD^BSDX07(.ZZZ,DATE,DATE+.001,3,"Dr Office",30,"Old Note",1)
    4547    N APPID S APPID=+$P(^BSDXTMP($J,1),U)
    46     D EDITAPT(.ZZZ,APTID,"New Note")
     48    D EDITAPT(.ZZZ,APPID,"New Note")
    4749    I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B
    4850    I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B
  • Scheduling/trunk/m/BSDX29.m

    r968 r1036  
    1 BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm
    2         ;;1.41;BSDX;;Sep 29, 2010
    3            ;
    4            ; Change Log:
    5            ; v1.3 by WV/SMH on 3100713
     1BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 6:05am
     2        ;;1.42;BSDX;;Sep 29, 2010
     3        ;
     4        ; Change Log:
     5        ; v1.3 by WV/SMH on 3100713
    66        ; - Beginning and Ending dates passed as FM Dates
     7    ; v1.42 by WV/SMH on 3101023
     8    ; - Transaction moved; now restartable too.
     9    ; --> Thanks to Zach Gonzalez and Rick Marshall.
     10    ; - Refactoring of major portions of routine
    711        ;
    812BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)   ;EP
    913        ;Entry point for debugging
    1014        ;
    11         ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
     15        D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
    1216        Q
    1317        ;
     
    1519        ;Copy appointments from HOSPITAL LOCATION entry BSDX44 to BSDX RESOURCE entry BSDXRES
    1620        ;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
    17         ;
    18         ;Returns ADO Recordset formatted fields containing count of records copied and error message:
    19            ;
    20            ; July 13 2010: D dates (BEG and END) from US format to FM Dates for i18n
    21         ;
    22         ;
    23         S BSDXY="^BSDXTMP("_$J_")"
    24         N BSDXI,BSDXST,ZTSK
    25         S BSDXI=0
    26         S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
     21    ;Called by RPC: BSDX COPY APPOINTMENTS
     22        ;
     23    ; Parameters:
     24    ; - BSDXY: Global Return
     25    ; - BSDXRES: BSDX RESOURCE to copy appointments to
     26    ; - BSDX44: Hospital Location IEN to copy appointments from
     27    ; - BSDXBEG: Beginning Date in FM Format
     28    ; - BSDXEND: End Date in FM Format
     29    ;
     30        ;Returns ADO Recordset containing TASK_NUMBER and ERRORID
     31        ;
     32    ; Return Array
     33        S BSDXY=$NA(^BSDXTMP($J))
     34    K ^BSDXTMP($J)
     35    ; $ET
     36    N $ET S $ET="G ETRAP^BSDX29"
     37        ; Counter
     38    N BSDXI S BSDXI=0
     39    ; Header Node
    2740        S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00020ERRORID"_$C(30)
    2841        ;
    29         ;Convert beginning and ending dates
    30            ;
    31            ;TODO:Validate FM Dates coming through
    32         ;
    33         S BSDXBEG=BSDXBEG-1
     42    ; Make dates inclusive; add 1 to FM dates
     43    S BSDXBEG=BSDXBEG-1
    3444        S BSDXEND=BSDXEND+1
    3545        ;
     46    ; Taskman variables
     47    N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
     48        ; Task Load
    3649        S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS"
    3750        S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
    3851        D ^%ZTLOAD
    39         ;
    40         S BSDXI=BSDXI+1
    41         S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")
     52        ; Set up return ADO.net dataset
     53        N BSDXST S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")
     54        S BSDXI=BSDXI+1
    4255        S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31)
    43         Q
    44         ;
    45 ZTMTST  ;
    46         ;
    47         S %DT="AE" D ^%DT S BSDXBEG=Y
    48         S %DT="AE" D ^%DT S BSDXEND=Y
    49         S BSDX44=3,BSDXSRES=1,ZTSK=3380
    50         D ZTM
    51         Q
     56        QUIT
    5257        ;
    5358ZTMD    ;EP - Debug entry point
     
    5560        Q
    5661        ;
    57 ZTM     ;EP
    58         ;Taskman entry point
    59         S X="ZTMERR^BSDX29",@^%ZOSF("TRAP")
     62ZTM     ;EP - Taskman entry point
     63    ; Variables set up in ZTSAVE above
     64    ;
     65        Q:'$D(ZTSK)
     66    ; $ET
     67    N $ET S $ET="G ZTMERR^BSDX29"
     68        ; Txn
     69    TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29"
    6070        ;$O through ^SC(BSDX44,"S",
    61         Q:'$D(ZTSK)
    62         N BSDXCNT,BSDXIEN,BSDXNOD,BSDXNOTE,BSDXCAN,BSDXPAT,BSDXLEN,BSDXMADE,BSDXCLRK,BSDXPAT,BSDXQUIT
    63         S BSDXCNT=0,BSDXQUIT=0
    64         S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
    65         TSTART
    66         F  S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG  Q:BSDXBEG>BSDXEND  Q:BSDXQUIT  D
    67         . S BSDXIEN=0 F  S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN  Q:BSDXQUIT  D
    68         . . S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0))
    69         . . Q:'+BSDXNOD
    70         . . S BSDXCAN=$P(BSDXNOD,U,9)
    71         . . Q:BSDXCAN="C"
    72         . . S BSDXPAT=$P(BSDXNOD,U)
    73         . . S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
    74         . . S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
    75         . . S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
    76         . . S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note
     71        N BSDXCNT S BSDXCNT=0  ; Count of Copied Appointments
     72    N BSDXQUIT S BSDXQUIT=0  ; Quit Flag to be retrieved from an external proc
     73        ; Set Count
     74    S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
     75        ; Loop through dates here.
     76    F  S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG  Q:BSDXBEG>BSDXEND  Q:BSDXQUIT  D
     77    . ; Loop through Entries in each date in the subsubfile.
     78    . ; Quit if we are at the end or if a remote process requests a quit.
     79    . N BSDXIEN S BSDXIEN=0
     80        . F  S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN  Q:BSDXQUIT  D
     81        . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node
     82        . . Q:'+BSDXNOD  ; Quit if no node
     83        . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag
     84        . . Q:BSDXCAN="C"  ; Quit if appt cancelled
     85    . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
     86    . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
     87        . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
     88        . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
     89        . . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note
    7790        . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE)
    7891        . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record
     
    8598        Q
    8699        ;
    87 ZTMERR  ;
    88         TROLLBACK
     100ZTMERR  ; For now, error from TM is only in trap; not returned to client.
     101        N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
     102    ; Rollback before logging the error
     103    I $TL>0 TROLLBACK
    89104        D ^%ZTER
    90         Q
     105    S $EC="" ; Clear Error
     106        QUIT
    91107        ;
    92108XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE)        ;EP
     
    132148ERR(BSDXI,BSDXCNT,BSDXERR)      ;Error processing
    133149        S BSDXI=BSDXI+1
     150    S BSDXERR=$TR(BSDXERR,"^","~")
    134151        S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
    135152        S BSDXI=BSDXI+1
     
    138155        ;
    139156ETRAP   ;EP Error trap entry
    140         D ^%ZTER
    141         I '$D(BSDXI) N BSDXI S BSDXI=999
    142         S BSDXI=BSDXI+1
    143         D ERR(BSDXI,$G(BSDXCNT),"Routine: BSDX29, Error: "_$G(%ZTERROR))
    144         Q
    145         ;
    146 CPSTAT(BSDXY,BSDXTSK)   ;EP
     157        ; No Txn here. So don't rollback anything
     158    N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
     159    D ^%ZTER
     160    S $EC="" ; Clear error
     161        I '$D(BSDXI) N BSDXI S BSDXI=0
     162        D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
     163        Q
     164        ;
     165CPSTAT(BSDXY,BSDXTSK)   ;EP - Note: As of Dec 6 2010: Inactive Code
    147166        ;Return status (copied record count) of tasked job having ZTSK=BSDXTSK
    148167        ;
     
    160179        Q
    161180        ;
    162 CPCANC(BSDXY,BSDXTSK)   ;EP
     181CPCANC(BSDXY,BSDXTSK)   ;EP Note: As of Dec 6 2010: Inactive code.
    163182        ;Signal tasked job having ZTSK=BSDXTSK to cancel
    164183        ;Returns current record count of copy process
  • Scheduling/trunk/m/BSDX31.m

    r968 r1036  
    1 BSDX31  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;1.41;BSDX;;Sep 29, 2010
    3         ;
    4         ;
    5 NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
    6         ;Entry point for debugging
    7         ;
    8         ;D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
    9         Q
    10         ;
    11 NOSHOW(BSDXY,BSDXAPTID,BSDXNS)         ;EP
    12         ;Called by BSDX NOSHOW
    13         ;Sets appointment noshow flag in BSDX APPOINTMENT file
    14         ;BSDXAPTID is entry number in BSDX APPOINTMENT file
    15         ;BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
    16         ;Calls CANCEL^BSDAPI to set noshow data in ^DPT
    17         ;Returns error code in recordset field ERRORID
    18         ;
    19         N BSDXNOD,BSDXPATID,BSDXSTART,BSDXID,BSDXI,BSDXZ,BSDXERR,BSDXMSG,BSDXFDA,BSDXIENS
    20         N BSDXNOEV
    21         S BSDXNOEV=1 ;Don't execute protocol
    22         ;
    23         D ^XBKVAR S X="ETRAP^BSDX31",@^%ZOSF("TRAP")
    24         S BSDXI=0
    25         K ^BSDXTMP($J)
    26         S BSDXY="^BSDXTMP("_$J_")"
    27         S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
    28         S BSDXI=BSDXI+1
    29         TSTART
    30         I '+BSDXAPTID D ERR(0,"BSDX31: Invalid Appointment ID") Q
    31         I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(0,"BSDX31: Invalid Appointment ID") Q
    32         S BSDXNS=+BSDXNS
    33         I BSDXNS'=1&(BSDXNS'=0) D ERR(0,"BSDX31: Invalid No Show value") Q
    34         ;
    35         ;Edit BSDX APPOINTMENT entry NOSHOW field
    36         S BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
    37         I BSDXNOD="" D ERR(0,"BSDX31: Invalid Appointment ID") Q
    38         S BSDXPATID=$P(BSDXNOD,U,5)
    39         S BSDXSTART=$P(BSDXNOD,U)
    40         ;
    41         D BSDXNOS(BSDXAPTID,BSDXNS)
    42         I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(0,"BSDX31: "_BSDXMSG) Q
    43         ;
    44         S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
    45         I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D  I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(0,BSDXERR) Q
    46         . S BSDXNOD=^BSDXRES(BSDXSC1,0)
    47         . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
    48         . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS)
    49         ;
    50         TCOMMIT
    51         S BSDXI=BSDXI+1
    52         S ^BSDXTMP($J,BSDXI)="1^"_$C(30)
    53         S BSDXI=BSDXI+1
    54         S ^BSDXTMP($J,BSDXI)=$C(31)
    55         Q
    56         ;
    57 APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS)            ;
    58         ; update file 2 info
    59         ;Set noshow for patient BSDXDFN in clinic BSDXSC1
    60         ;at time BSDXSD
    61         N BSDXC,%H,BSDXCDT,BSDXIEN
    62         N BSDXIENS,BSDXFDA,BSDXMSG
    63         S %H=$H D YMD^%DTC
    64         S BSDXCDT=X+%
    65         ;
    66         S BSDXIENS=BSDXSD_","_BSDXDFN_","
    67         I +BSDXNS D
    68         . S BSDXFDA(2.98,BSDXIENS,3)="N"
    69         . S BSDXFDA(2.98,BSDXIENS,14)=DUZ
    70         . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT
    71         E  D
    72         . S BSDXFDA(2.98,BSDXIENS,3)=""
    73         . S BSDXFDA(2.98,BSDXIENS,14)=""
    74         . S BSDXFDA(2.98,BSDXIENS,15)=""
    75         K BSDXIEN
    76         D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
    77         S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1))
    78         Q
    79         ;
    80 BSDXNOS(BSDXAPTID,BSDXNS)       ;
    81         ;
    82         N BSDXFDA,BSDXIENS
    83         S BSDXIENS=BSDXAPTID_","
    84         S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW
    85         D FILE^DIE("","BSDXFDA","BSDXMSG")
    86         ;
    87         Q
    88         ;
    89 NOSEVT(BSDXPAT,BSDXSTART,BSDXSC)        ;EP Called by BSDX NOSHOW APPOINTMENT event
    90         ;when appointments NOSHOW via PIMS interface.
    91         ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
    92         ;
    93         Q:+$G(BSDXNOEV)
    94         Q:'+$G(BSDXSC)
    95         Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
    96         N BSDXSTAT,BSDXFOUND,BSDXRES
    97         S BSDXSTAT=1
    98         S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
    99         S BSDXFOUND=0
    100         I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
    101         I BSDXFOUND D NOSEVT3(BSDXRES) Q
    102         I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
    103         I BSDXFOUND D NOSEVT3(BSDXRES)
    104         Q
    105         ;
    106 NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)     ;
    107         ;Get appointment id in BSDXAPT
    108         ;If found, call BSDXNOS(BSDXAPPT) and return 1
    109         ;else return 0
    110         N BSDXFOUND,BSDXAPPT
    111         S BSDXFOUND=0
    112         Q:'+$G(BSDXRES) BSDXFOUND
    113         Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
    114         S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
    115         . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
    116         . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
    117         I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT)
    118         Q BSDXFOUND
    119         ;
    120 NOSEVT3(BSDXRES)        ;
    121         ;Call RaiseEvent to notify GUI clients
    122         ;
    123         N BSDXRESN
    124         S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
    125         Q:BSDXRESN=""
    126         S BSDXRESN=$P(BSDXRESN,"^")
    127         D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
    128         Q
    129         ;
    130         ;
    131 ERR(BSDXERID,ERRTXT)    ;Error processing
    132         S:'+$G(BSDXI) BSDXI=999999
    133         S BSDXI=BSDXI+1
    134         TROLLBACK
    135         S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
    136         S BSDXI=BSDXI+1
    137         S ^BSDXTMP($J,BSDXI)=$C(31)
    138         Q
    139         ;
    140 ETRAP   ;EP Error trap entry
    141         D ^%ZTER
    142         I '$D(BSDXI) N BSDXI S BSDXI=999999
    143         S BSDXI=BSDXI+1
    144         D ERR(0,"BSDX31 Error: "_$G(%ZTERROR))
    145         Q
    146         ;
    147 IMHERE(BSDXRES) ;EP
    148         ;Entry point for BSDX IM HERE remote procedure
    149         S BSDXRES=1
    150         Q
    151         ;
     1BSDX31  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 8:25am
     2    ;;1.42;BSDX;;Sep 29, 2010
     3    ; Change Log:
     4    ; v1.42 Oct 23 2010 WV/SMH
     5    ; - Change transaction to restartable. Thanks to Zach Gonzalez
     6    ; --> and Rick Marshall for their help.
     7    ; v1.42 Dec 6 2010: Extensive refactoring
     8    ;
     9    ; Error Reference:
     10    ; -1: zero or null Appt ID
     11    ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT)
     12    ; -3: No-show flag is invalid
     13    ; -100: M Error
     14    ;
     15    ;
     16NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP
     17    ;Entry point for debugging
     18    ;
     19    D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")
     20    Q
     21    ;
     22UT ; Unit Tests
     23    ; Test 1: Sanity Check
     24    N ZZZ ; Garbage return variable
     25    N DATE S DATE=$$NOW^XLFDT()
     26    S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
     27    D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1)
     28    N APPID S APPID=+$P(^BSDXTMP($J,1),U)
     29    D NOSHOW(.ZZZ,APPID,1)
     30    I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B
     31    I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B
     32    ; Test 2: Undo noshow
     33    D NOSHOW(.ZZZ,APPID,0)
     34    I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B
     35    I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B
     36    ; Test 3: -1
     37    D NOSHOW(.ZZZ,"",0)
     38    I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B
     39    ; Test 4: -2
     40    D NOSHOW(.ZZZ,2938748233,0)
     41    I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B
     42    QUIT
     43NOSHOW(BSDXY,BSDXAPTID,BSDXNS)         ;EP - No show a patient
     44    ; Called by RPC: BSDX NOSHOW
     45    ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2
     46    ;
     47    ; Parameters:
     48    ; BSDXY: Global Return
     49    ; BSDXAPTID is entry number in BSDX APPOINTMENT file
     50    ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO
     51    ;
     52    ; Returns ADO.net record set with fields
     53    ; - ERRORID; ERRORTEXT
     54    ; ERRORID of 1 is okay
     55    ; Anything else is an error.
     56    ;
     57    ; Return Array; set and clear
     58    S BSDXY=$NA(^BSDXTMP($J))
     59    K ^BSDXTMP($J)
     60    ; $ET
     61    N $ET S $ET="G ETRAP^BSDX31"
     62    ; Basline vars
     63    D ^XBKVAR  ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist
     64    ; Counter
     65    N BSDXI S BSDXI=0
     66    ; Header Node
     67    S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
     68    ; Begin transaction
     69    TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29"
     70    ; Turn off SDAM APPT PROTOCOL BSDX Entries
     71    N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
     72    ; Appointment ID check
     73    I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q
     74    I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
     75    ; Noshow value check - Must be 1 or 0
     76    S BSDXNS=+BSDXNS
     77    I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q
     78    ; Get Some data
     79    N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node
     80    N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
     81    N BSDXSTART S BSDXSTART=$P(BSDXNOD,U)  ; Start Date/Time
     82    ; Edit BSDX APPOINTMENT entry
     83    N BSDXMSG  ;
     84    D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG)  ;Edit BSDX APPOINTMENT entry NOSHOW field
     85    I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q
     86    ; Edit File 2 "S" node entry
     87    N BSDXZ,BSDXERR ; Error variables to control looping
     88    S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
     89    ; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2
     90    I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D  I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q
     91    . S BSDXNOD=^BSDXRES(BSDXSC1,0)
     92    . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
     93    . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS)
     94    ;
     95    TCOMMIT
     96    S BSDXI=BSDXI+1
     97    S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay
     98    S BSDXI=BSDXI+1
     99    S ^BSDXTMP($J,BSDXI)=$C(31)
     100    QUIT
     101    ;
     102APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS)            ;
     103    ; update file 2 info
     104    ;Set noshow for patient BSDXDFN in clinic BSDXSC1
     105    ;at time BSDXSD
     106    N BSDXC,%H,BSDXCDT,BSDXIEN
     107    N BSDXIENS,BSDXFDA,BSDXMSG
     108    S %H=$H D YMD^%DTC
     109    S BSDXCDT=X+%
     110    ;
     111    S BSDXIENS=BSDXSD_","_BSDXDFN_","
     112    I +BSDXNS D
     113    . S BSDXFDA(2.98,BSDXIENS,3)="N"
     114    . S BSDXFDA(2.98,BSDXIENS,14)=DUZ
     115    . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT
     116    E  D
     117    . S BSDXFDA(2.98,BSDXIENS,3)=""
     118    . S BSDXFDA(2.98,BSDXIENS,14)=""
     119    . S BSDXFDA(2.98,BSDXIENS,15)=""
     120    K BSDXIEN
     121    D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
     122    S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1))
     123    Q
     124    ;
     125BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG)   ;
     126    ;
     127    N BSDXFDA,BSDXIENS
     128    S BSDXIENS=BSDXAPTID_","
     129    S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW
     130    D FILE^DIE("","BSDXFDA","BSDXMSG")
     131    QUIT
     132    ;
     133NOSEVT(BSDXPAT,BSDXSTART,BSDXSC)    ;EP Called by BSDX NOSHOW APPOINTMENT event
     134    ;when appointments NOSHOW via PIMS interface.
     135    ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients
     136    ;
     137    Q:+$G(BSDXNOEV)
     138    Q:'+$G(BSDXSC)
     139    Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
     140    N BSDXSTAT,BSDXFOUND,BSDXRES
     141    S BSDXSTAT=1
     142    S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0
     143    S BSDXFOUND=0
     144    I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
     145    I BSDXFOUND D NOSEVT3(BSDXRES) Q
     146    I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
     147    I BSDXFOUND D NOSEVT3(BSDXRES)
     148    Q
     149    ;
     150NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
     151    ;Get appointment id in BSDXAPT
     152    ;If found, call BSDXNOS(BSDXAPPT) and return 1
     153    ;else return 0
     154    N BSDXFOUND,BSDXAPPT
     155    S BSDXFOUND=0
     156    Q:'+$G(BSDXRES) BSDXFOUND
     157    Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
     158    S BSDXAPPT=0 F  S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT  D  Q:BSDXFOUND
     159    . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
     160    . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
     161    I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT)
     162    Q BSDXFOUND
     163    ;
     164NOSEVT3(BSDXRES)    ;
     165    ;Call RaiseEvent to notify GUI clients
     166    ;
     167    N BSDXRESN
     168    S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
     169    Q:BSDXRESN=""
     170    S BSDXRESN=$P(BSDXRESN,"^")
     171    D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
     172    Q
     173    ;
     174    ;
     175ERR(BSDXERID,ERRTXT)    ;Error processing
     176    S BSDXI=BSDXI+1
     177    TROLLBACK
     178    S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
     179    S BSDXI=BSDXI+1
     180    S ^BSDXTMP($J,BSDXI)=$C(31)
     181    Q
     182    ;
     183ETRAP   ;EP Error trap entry
     184    D ^%ZTER
     185    I '$D(BSDXI) N BSDXI S BSDXI=999999
     186    S BSDXI=BSDXI+1
     187    D ERR(0,"BSDX31 Error: "_$G(%ZTERROR))
     188    Q
     189    ;
     190IMHERE(BSDXRES) ;EP
     191    ;Entry point for BSDX IM HERE remote procedure
     192    S BSDXRES=1
     193    Q
     194    ;
Note: See TracChangeset for help on using the changeset viewer.