Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDTMP08

SDTMP08.m

Go to the documentation of this file. 
  1. SDTMP08 ;MS/PB- VISTA SCHEDULING RPCS ;DEC 6, 2018
  1.  ;;5.3;Scheduling;**704,859**;DEC 6, 2018;Build 10
  1.  ;
  1.  Q
  1.  ;
  1. APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) ;Cancels appointment
  1.  ;APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) external parameter tag is in SDEC
  1.  ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file
  1.  ;SDECTYP - (required) appointment Status valid values:
  1.  ; C=CANCELLED BY CLINIC
  1.  ; PC=CANCELLED BY PATIENT
  1.  ;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2)
  1.  ;SDECNOT - (optional) text representing user note
  1.  ;SDECDATE - (optional) Cancel Date/Time in external format; defaults to NOW
  1.  ;SDUSER - (optional) User that cancelled appt; defaults to current user
  1.  ;Returns error code in recordset field ERRORID
  1.  ;
  1.  N SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECI,SDECZ,SDECERR
  1.  N SDECLOC,SDECLEN,SDECSCIEN,SDECSCIEN1
  1.  N SDECNOEV,SDECSC1,SDRET
  1.  N %DT,X,Y
  1.  S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol
  1.  S SDECSCIEN1=0
  1.  ;
  1.  S SDECI=0
  1.  S SDECY="^TMP(""SDEC08"","_$J_",""APPDEL"")"
  1.  K @SDECY
  1.  S @SDECY@(SDECI)="T00020ERRORID"_$C(30)
  1.  S SDECI=SDECI+1
  1.  ;validate SDEC APPOINTMENT pointer (required)
  1.  I '$D(^SDEC(409.84,+$G(SDECAPTID),0)) D ERR(SDECI,"SDEC08: Invalid Appointment ID") Q
  1.  ;validate appointment status type (required)
  1.  S SDECTYP=$G(SDECTYP)
  1.  S SDECTYP=$S(SDECTYP="C":"C",SDECTYP="CANCELLED BY CLINIC":"C",SDECTYP="PC":"PC",SDECTYP="CANCELLED BY PATIENT":"PC",1:"")
  1.  I SDECTYP="" D ERR(SDECI,"SDEC08: Invalid status type") Q
  1.  ;validate CANCELLATION REASON pointer (optional)
  1.  S SDECCR=$G(SDECCR)
  1.  I SDECCR'="" S SDECCR=$O(^SD(409.2,"B",$G(SDECCR),"")) ;859 - correct misspelling
  1.  ;validate SDECNOT
  1.  S SDECNOT=$TR(SDECNOT,"^"," ") ;alb/sat 658 - strip out ^
  1.  ;validate cancel date/time
  1.  S SDECDATE=$G(SDECDATE)
  1.  I SDECDATE'="" S %DT="T" S X=SDECDATE D ^%DT S SDECDATE=Y I Y=-1 S SDECDATE=""
  1.  I $G(SDECDATE)="" S SDECDATE=$$NOW^XLFDT
  1.  ;validate user
  1.  S SDUSER=$G(SDUSER)
  1.  I SDUSER'="" I '$D(^VA(200,+SDUSER,0)) S SDUSER=""
  1.  I SDUSER="" S SDUSER=DUZ
  1.  ;
  1.  ;TSTART
  1.  ;
  1.  ;Delete APPOINTMENT entries
  1.  S SDECNOD=^SDEC(409.84,SDECAPTID,0)
  1.  S SDECPATID=$P(SDECNOD,U,5)
  1.  S SDECSTART=$P(SDECNOD,U)
  1.  ;
  1.  ;Lock SDEC node
  1.  L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") Q  ;TROLLBACK Q
  1.  ;cancel check-in if walk-in
  1.  I $P(SDECNOD,U,13)="y" D
  1.  .S SDRET=""
  1.  .D CHECKIN^SDEC25(.SDRET,SDECAPTID,"@")
  1.  ;cancel SDEC APPOINTMENT record
  1.  D SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,1)
  1.  ;
  1.  S SDECSC1=$P(SDECNOD,U,7) ;RESOURCEID
  1.  I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D  I +$G(SDECZ) S SDECERR=+SDECZ D ERR(SDECI,$P(SDECZ,U,2)) Q
  1.  . S SDECNOD=^SDEC(409.831,SDECSC1,0)
  1.  . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION
  1.  . Q:'+SDECLOC
  1.  . S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I SDECSCIEN="" D  I 'SDECZ Q  ;Q:SDECZ
  1.  . . S SDECERR="SDEC08: Unable to find associated appointment for this patient. "
  1.  . . S SDECZ=1
  1.  . . I '$D(^SDEC(409.831,SDECSC1,20)) S SDECZ=0 Q
  1.  . . N SDEC1
  1.  . . S SDEC1=0
  1.  . . F  S SDEC1=$O(^SDEC(409.831,SDECSC1,20,SDEC1)) Q:'+SDEC1  Q:SDECZ=0  D
  1.  . . . Q:'$D(^SDEC(409.831,SDECSC1,20,SDEC1,0))
  1.  . . . S SDECLOC=$P(^SDEC(409.831,SDECSC1,20,SDEC1,0),U)
  1.  . . . S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I +SDECSCIEN S SDECZ=0 Q
  1.  . S SDECERR="SDEC08: CANCEL^SDEC08 Returned "
  1.  . I SDECLOC']"" S SDECZ="0^Unable to find associated appointment for this patient." Q
  1.  . I '$D(^SC(SDECLOC,0)) S SDECZ="0^Unable to find associated appointment for this patient." Q
  1.  . S SDECNOD=$G(^SC(SDECLOC,"S",SDECSTART,1,+SDECSCIEN,0))
  1.  . I SDECNOD="" S SDECZ="0^Unable to find associated appointment for this patient." Q
  1.  . S SDECLEN=$P(SDECNOD,U,2)
  1.  . D APCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECAPTID,SDECLEN)
  1.  . Q:+$G(SDECZ)
  1.  . D AVUPDT(SDECLOC,SDECSTART,SDECLEN)
  1.  . D AR433D^SDECAR2(SDECAPTID)
  1.  . ;L
  1.  ;
  1.  ;TCOMMIT
  1.  L -^SDEC(409.84,SDECPATID)
  1.  S SDECI=SDECI+1
  1.  S @SDECY@(SDECI)=""_$C(30)
  1.  S SDECI=SDECI+1
  1.  S @SDECY@(SDECI)=$C(31)
  1.  Q
  1.  ;
  1. AVUPDT(SDECSCD,SDECSTART,SDECLEN) ;Update Clinic availability
  1.  ;See SDCNP0
  1.  N HSI,I,S,SB,SD,SDDIF,SI,SL,SS,ST,STARTDAY,STR,X,Y
  1.  S (SD,S)=SDECSTART
  1.  S I=SDECSCD
  1.  Q:'$D(^SC(I,"ST",SD\1,1))
  1.  S SL=^SC(I,"SL"),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2)
  1.  S SL=SDECLEN
  1.  S S=^SC(I,"ST",SD\1,1),Y=SD#1-SB*100,ST=Y#1*SI\.6+(Y\1*SI),SS=SL*HSI/60
  1.  I Y'<1 F I=ST+ST:SDDIF S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y=""  S S=$E(S,1,I)_Y_$E(S,I+2,999),SS=SS-1 Q:SS'>0
  1.  S ^SC(SDECSCD,"ST",SD\1,1)=S
  1.  Q
  1.  ;
  1. APCAN(SDECZ,SDECLOC,SDECDFN,SDECSD,SDECAPTID,SDECLEN) ;
  1.  ;Cancel appointment for patient SDECDFN in clinic SDECSC1
  1.  ;at time SDECSD
  1.  N SDECPNOD,SDECC,DA,DIE,DPTST,DR,%H
  1.  ;save data into SDEC APPOINTMENT in case of un-cancel (status & appt length)
  1.  S SDECPNOD=^DPT(SDECPATID,"S",SDECSD,0)
  1.  S DPTST=$P(SDECPNOD,U,2)
  1.  S DIE=409.84
  1.  S DA=SDECAPTID
  1.  S DR=".17///"_DPTST_";"_".18///"_SDECLEN
  1.  D ^DIE
  1.  S SDECC("PAT")=SDECDFN
  1.  S SDECC("CLN")=SDECLOC
  1.  S SDECC("TYP")=SDECTYP
  1.  S SDECC("ADT")=SDECSD
  1.  S %H=$H D YMD^%DTC
  1.  S SDECC("CDT")=SDECDATE   ;X+%
  1.  S SDECC("NOT")=SDECNOT
  1.  S:+SDECCR SDECC("CR")=SDECCR
  1.  S SDECC("USR")=SDUSER
  1.  ;
  1.  S SDECZ=$$CANCEL(.SDECC)
  1.  Q
  1.  ;
  1. SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SDF) ;cancel SDEC APPOINTMENT entry
  1.  ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file
  1.  ;SDECTYP - (required) appointment Status valid values:
  1.  ; C=CANCELLED BY CLINIC
  1.  ; PC=CANCELLED BY PATIENT
  1.  ;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2)
  1.  ;SDECNOT - (optional) text representing user note
  1.  ;SDECDATE - (optional) Cancel Date/Time in fm format; defaults to NOW) ;
  1.  ;SDF - (optional) flags
  1.  ; 1. called from GUI (update consult only if called from GUI)
  1.  ; 2. called from cancel in SDAM (CAN^SDCNP0) (do not reopen appt)
  1.  ;Cancel SDEC APPOINTMENT entry
  1.  N DFN,PROVIEN,Y
  1.  N SAVESTRT,SDAPTYP,SDCL,SDI,SDIEN,SDECIENS,SDECFDA,SDECMSG,SDECWP,SDRES,SDT   ;alb/sat 651 add SAVESTRT and SDRES
  1.  S SDF=$G(SDF,0)
  1.  S DFN=$$GET1^DIQ(409.84,SDECAPTID_",",.05) ;alb/sat 658
  1.  S SDT=$$GET1^DIQ(409.84,SDECAPTID_",",.01,"I")
  1.  S SAVESTRT=$$GET1^DIQ(409.84,SDECAPTID_",",.01) ;alb/sat 651
  1.  S SDRES=$$GET1^DIQ(409.84,SDECAPTID_",",.07,"I") ;alb/sat 651
  1.  S SDECIENS=SDECAPTID_","
  1.  S SDECFDA(409.84,SDECIENS,.12)=$S($G(SDECDATE)'="":SDECDATE,1:$$NOW^XLFDT)
  1.  S SDECFDA(409.84,SDECIENS,.121)=$S($G(SDUSER)'="":SDUSER,1:DUZ)
  1.  S:$G(SDECCR)'="" SDECFDA(409.84,SDECIENS,.122)=SDECCR
  1.  S SDECFDA(409.84,SDECIENS,.17)=SDECTYP
  1.  K SDECMSG
  1.  D FILE^DIE("","SDECFDA","SDECMSG")
  1.  S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I")
  1.  ;alb/sat 658 modification begin
  1.  S SDECNOT=$G(SDECNOT),SDECNOT=$E(SDECNOT,1,160)
  1.  I $L(SDECNOT)>2,'$E(SDF,2) K SDECFDA S SDECFDA(2.98,SDT_","_DFN_",",17)=SDECNOT D UPDATE^DIE("","SDECFDA")
  1.  ;alb/sat 658 modification end
  1.  I $P(SDAPTYP,";",2)="GMR(123,",$E(SDF,1) D
  1.  .S SDCL=$$SDCL^SDECUTL(SDECAPTID)
  1.  .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I")
  1.  .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",2,SDECTYP,SDECNOT,SAVESTRT,SDRES) ;alb/sat 651 added SAVESTRT
  1.  I $P(SDAPTYP,";",2)="SDWL(409.3," D   ;update EWL
  1.  .S DFN=$$GET1^DIQ(409.3,$P(SDAPTYP,";",1)_",",.01,"I")
  1.  .Q:DFN=""
  1.  .S SDIEN=0 F  S SDIEN=$O(^SDWL(409.3,"B",DFN,SDIEN)) Q:SDIEN=""  D
  1.  ..I $$GET1^DIQ(409.3,SDIEN_",",13,"I")=SDT D
  1.  ...K SDECFDA,SDECMSG,SDECWP
  1.  ...;S SDIEN=$P(SDAPTYP,";",1)
  1.  ...S SDECFDA(409.3,SDIEN_",",13)="@"
  1.  ...S SDECFDA(409.3,SDIEN_",",13.1)="@"
  1.  ...S SDECFDA(409.3,SDIEN_",",13.2)="@"
  1.  ...S SDECFDA(409.3,SDIEN_",",13.3)="@"
  1.  ...S SDECFDA(409.3,SDIEN_",",13.4)="@"
  1.  ...S SDECFDA(409.3,SDIEN_",",13.5)="@"
  1.  ...S SDECFDA(409.3,SDIEN_",",13.6)="@"
  1.  ...S SDECFDA(409.3,SDIEN_",",13.7)="@"
  1.  ...S SDECFDA(409.3,SDIEN_",",13.8)="@"
  1.  ...D UPDATE^DIE("","SDECFDA")
  1.  ...D:'$E(SDF,2) WLOPEN^SDECWL("","",SDIEN) ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0
  1.  I $P(SDAPTYP,";",2)="SDEC(409.85," D   ;update APPT
  1.  .K SDECFDA,SDECMSG,SDECWP
  1.  .D:'$E(SDF,2) AROPEN^SDECAR("",SDECAPTID) ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0
  1.  .S SDIEN=$P(SDAPTYP,";",1)
  1.  .S SDECFDA(409.85,SDIEN_",",13)="@"
  1.  .S SDECFDA(409.85,SDIEN_",",13.1)="@"
  1.  .S SDECFDA(409.85,SDIEN_",",13.2)="@"
  1.  .S SDECFDA(409.85,SDIEN_",",13.3)="@"
  1.  .S SDECFDA(409.85,SDIEN_",",13.4)="@"
  1.  .S SDECFDA(409.85,SDIEN_",",13.5)="@"
  1.  .S SDECFDA(409.85,SDIEN_",",13.6)="@"
  1.  .S SDECFDA(409.85,SDIEN_",",13.7)="@"
  1.  .S SDECFDA(409.85,SDIEN_",",13.8)="@"
  1.  .D UPDATE^DIE("","SDECFDA")
  1.  Q
  1.  ;
  1. CANEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CANCEL APPOINTMENT event
  1.  ;when appointments cancelled via PIMS interface.
  1.  ;Propagates cancellation to SDECAPPT and raises refresh event to running GUI clients
  1.  N SDECFOUND,SDECRES
  1.  Q:+$G(SDECNOEV)
  1.  Q:'+$G(SDECSC)
  1.  S SDECFOUND=0
  1.  I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CANEVT1(SDECRES,SDECSTART,SDECPAT)
  1.  I SDECFOUND D CANEVT3(SDECRES) Q
  1.  Q
  1.  ;
  1. CANEVT1(SDECRES,SDECSTART,SDECPAT) ;
  1.  ;Get appointment id in SDECAPT
  1.  ;If found, call SDECCAN(SDECAPPT) and return 1
  1.  ;else return 0
  1.  N SDECFOUND,SDECAPPT
  1.  S SDECFOUND=0
  1.  Q:'+SDECRES SDECFOUND
  1.  Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND
  1.  S SDECAPPT=0 F  S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT  D  Q:SDECFOUND
  1.  . S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD=""
  1.  .  I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q
  1.  I SDECFOUND,+$G(SDECAPPT) D SDECCAN(SDECAPPT,,,,,,1)
  1.  Q SDECFOUND
  1.  ;
  1. CANEVT3(SDECRES) ;
  1.  ;Call RaiseEvent to notify GUI clients
  1.  ;
  1.  Q
  1.  N SDECRESN
  1.  S SDECRESN=$G(^SDEC(409.831,SDECRES,0))
  1.  Q:SDECRESN=""
  1.  S SDECRESN=$P(SDECRESN,"^")
  1.  ;D EVENT^SDEC23("SCHEDULE-"_SDECRESN,"","","")
  1.  ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN)
  1.  Q
  1.  ;
  1. CANCEL(BSDR) ;EP; called to cancel appt
  1.  ;
  1.  ; Make call using: S ERR=$$CANCEL^SDEC08(.ARRAY)
  1.  ;
  1.  ; Input Array -
  1.  ; BSDR("PAT") = ien of patient in file 2
  1.  ; BSDR("CLN") = ien of clinic in file 44
  1.  ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
  1.  ; BSDR("ADT") = appointment date and time
  1.  ; BSDR("CDT") = cancel date and time
  1.  ; BSDR("USR") = user who canceled appt
  1.  ; BSDR("CR") = cancel reason - pointer to file 409.2
  1.  ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
  1.  ;
  1.  ;Output: error status and message
  1.  ; = 0 or null: everything okay
  1.  ; = 1^message: error and reason
  1.  ;
  1.  I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
  1.  I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
  1.  I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
  1.  I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
  1.  I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
  1.  I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
  1.  I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
  1.  I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
  1.  I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
  1.  ;
  1.  NEW IEN,DIE,DA,DR,SDMODE
  1.  S IEN=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
  1.  I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
  1.  ;
  1.  I $$CI^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until check-in deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
  1.  ;
  1.  ; remember before status
  1.  NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
  1.  S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
  1.  S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
  1.  D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
  1.  ;
  1.  ; get user who made appt and date appt made from ^SC
  1.  ; because data in ^SC will be deleted
  1.  NEW USER,DATE
  1.  S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
  1.  S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
  1.  ;
  1.  ; update file 2 info
  1.  NEW DIE,DA,DR
  1.  N SDFDA,SDIEN,SDMSG
  1.  S SDFDA="SDFDA(2.98,SDT_"",""_DFN_"","")"
  1.  S @SDFDA@(3)=BSDR("TYP")
  1.  S @SDFDA@(14)=BSDR("USR")
  1.  S @SDFDA@(15)=BSDR("CDT")
  1.  S:+$G(BSDR("CR")) @SDFDA@(16)=BSDR("CR")
  1.  S:$G(BSDR("NOT"))]"" @SDFDA@(17)=$E(BSDR("NOT"),1,160)
  1.  S @SDFDA@(19)=USER
  1.  S @SDFDA@(20)=DATE
  1.  D UPDATE^DIE("","SDFDA")
  1.  S DUZ=$G(MSGARY("DUZ"))
  1.  S:$G(DUZ(2))="" DUZ=$$KSP^XUPARAM("SITE")
  1.  N SDPCE
  1.  S SDPCE=$P($G(^DPT(DFN,"S",SDT,0)),U,20)
  1.  D:+SDPCE EN^SDCODEL(SDPCE,0) ;remove OUTPATIENT ENCOUNTER link
  1.  ;
  1.  ; delete data in ^SC
  1.  NEW DIK,DA
  1.  S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
  1.  S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
  1.  D ^DIK
  1.  ; call event driver
  1.  S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
  1.  ;D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
  1.  Q 0
  1.  ;
  1. UNDOCANA(SDECY,SDECAPTID) ;Undo Cancel Appointment
  1.  ;UNDOCANA(SDECY,SDECAPTID) external parameter tag in SDEC
  1.  ;called by SDEC UNCANCEL APPT
  1.  ; SDECAPTID = ien of appointment in SDEC APPOINTMENT (^SDECAPPT) file 409.84
  1.  N SDECDAM,SDECDEC,SDECI,SDECNOD,SDECPATID,SDECSTART
  1.  S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol ;is this used?
  1.  ;
  1.  S SDECI=0
  1.  K ^TMP("SDEC",$J)
  1.  S SDECY="^TMP(""SDEC"","_$J_")"
  1.  S ^TMP("SDEC",$J,SDECI)="T00020ERRORID"_$C(30)
  1.  ;TSTART
  1.  ;I '+SDECAPTID TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID.") Q
  1.  I '+SDECAPTID D ERR(SDECI+1,"Invalid Appointment ID.") Q
  1.  ;I '$D(^SDEC(409.84,SDECAPTID,0)) TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID") Q
  1.  I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR(SDECI+1,"Invalid Appointment ID") Q
  1.  ;Make sure appointment is cancelled
  1.  ;I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" TROLLBACK D ERR(SDECI+1,"Appointment is not Cancelled.") Q
  1.  I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" D ERR(SDECI+1,"Appointment is not Cancelled.") Q 
  1.  S SDECNOD=^SDEC(409.84,SDECAPTID,0)
  1.  ;appts cancelled by patient cannot be un-cancelled. /* removed 9/17/2010 */
  1.  ;I $P(^DPT($P(SDECNOD,U,5),"S",$P(SDECNOD,U,1),0),U,2)="PC" TROLLBACK D ERR(SDECI+1,"Cancelled by patient appointment cannot be uncancelled.") Q
  1.  ;get appointment data
  1.  S SDECNOD=^SDEC(409.84,SDECAPTID,0)
  1.  S SDECDAM=$P(SDECNOD,U,9) ;date appt made
  1.  S SDECDEC=$P(SDECNOD,U,8) ;data entry clerk
  1.  S SDECLEN=$P(SDECNOD,U,18) ;length of appt in minutes
  1.  S SDECNOTE=$G(^SDEC(409.84,SDECAPTID,1,1,0)) ;note from SDEC APPOINTMENT
  1.  S SDECPATID=$P(SDECNOD,U,5) ;pointer to VA PATIENT file 2
  1.  S SDECSC1=$P($G(SDECNOD),U,7) ;resource
  1.  S SDECSTART=$P(SDECNOD,U) ;appt start time
  1.  S SDECWKIN=$P($G(SDECNOD),U,13) ;walk-in
  1.  ;lock SDEC node
  1.  ;L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") TROLLBACK Q
  1.  L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") Q
  1.  ;un-cancel SDEC APPOINTMENT
  1.  D SDECUCAN(SDECAPTID)
  1.  I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D  I +$G(SDECZ) S SDECERR=SDECERR_$P(SDECZ,U,2) D ERR(SDECI,SDECERR) Q
  1.  . S SDECLOC=""
  1.  . S SDECNOD=^SDEC(409.831,SDECSC1,0)
  1.  . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION ;support for single HOSPITAL LOCATION in SDEC RESOURCE
  1.  . I SDECLOC="" S SDECLOC=$$SDCL^SDECUTL(SDECAPTID) ;HOSPITAL LOCATION
  1.  . Q:'+SDECLOC
  1.  . ;un-cancel patient appointment and re-instate clinic appointment
  1.  . S SDECZ=""
  1.  . D APUCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECSC1,SDECWKIN)
  1.  ;TCOMMIT
  1.  L -^SDEC(409.84,SDECPATID)
  1.  S SDECI=SDECI+1
  1.  S ^TMP("SDEC",$J,SDECI)=""_$C(30)
  1.  S SDECI=SDECI+1
  1.  S ^TMP("SDEC",$J,SDECI)=$C(31)
  1.  Q
  1.  ;
  1. SDECUCAN(SDECAPTID) ;called internally to update SDEC APPOINTMENT by clearing cancel date/time
  1.  N PROVIEN,SDAPTYP,SDCL,SDRES
  1.  S SDECIENS=SDECAPTID_","
  1.  S SDECFDA(409.84,SDECIENS,.12)=""
  1.  K SDECMSG
  1.  D FILE^DIE("","SDECFDA","SDECMSG")
  1.  S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I")
  1.  I $P(SDAPTYP,";",2)="GMR(123," D
  1.  .S SDCL=$$SDCL^SDECUTL(SDECAPTID)
  1.  .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I")
  1.  .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",1)
  1.  Q
  1.  ;
  1. APUCAN(SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECRES,SDECWKIN) ;
  1.  ;un-Cancel appointment for patient SDECDFN in clinic SDECSC1
  1.  ; SDECLOC = pointer to hospital location ^SC file 44
  1.  ; SDECPATID = pointer to VA Patient ^DPT file 2
  1.  ; SDECSTART = Appointment time
  1.  ; SDECDAM = Date appointment made in FM format
  1.  ; SDECDEC = Data entry clerk - pointer to NEW PERSON file 200
  1.  N SDECC,%H
  1.  S SDECC("PAT")=SDECPATID
  1.  S SDECC("CLN")=SDECLOC
  1.  S SDECC("ADT")=SDECSTART
  1.  S SDECC("NOTE")=SDECNOTE  ;user note
  1.  S SDECC("RES")=SDECRES
  1.  S SDECC("USR")=DUZ
  1.  S SDECC("LEN")=SDECLEN
  1.  S SDECC("WKIN")=SDECWKIN
  1.  ;
  1.  S SDECZ=$$UNCANCEL(.SDECC)
  1.  Q
  1.  ;
  1. UNCANCEL(BSDR) ;PEP; called to un-cancel appt
  1.  ;
  1.  ; Make call using: S ERR=$$UNCANCEL(.ARRAY)
  1.  ;
  1.  ; Input Array -
  1.  ; BSDR("PAT") = ien of patient in file 2
  1.  ; BSDR("CLN") = ien of clinic in file 44
  1.  ; BSDR("ADT") = appointment date and time
  1.  ; BSDR("USR") = user who un-canceled appt
  1.  ; BSDR("NOTE") = appointment note from SDEC APPOINTMENT
  1.  ; BSDR("LEN") = appt length in minutes (numeric)
  1.  ; BSDR("RES") = resource
  1.  ; BSDR("WKIN")= walk-in
  1.  ;
  1.  ;Output: error status and message
  1.  ; = 0 or null: everything okay
  1.  ; = 1^message: error and reason
  1.  ;
  1.  N DPTNOD,DPTNODR
  1.  I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
  1.  I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
  1.  I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
  1.  I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
  1.  I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
  1.  ;
  1.  S SDECERR=$$APPVISTA^SDEC07B(BSDR("LEN"),BSDR("NOTE"),BSDR("PAT"),BSDR("RES"),BSDR("ADT"),BSDR("WKIN"),BSDR("CLN"),.SDECI) ;alb/sat 665 APPVISTA moved to SDEC07B
  1.  Q SDECERR
  1.  ;
  1. ERR(SDECI,SDECERR) ;Error processing
  1.  S SDECI=SDECI+1
  1.  S SDECERR=$TR(SDECERR,"^","~")
  1.  ;TROLLBACK
  1.  S ^TMP("SDEC",$J,SDECI)=SDECERR_$C(30)
  1.  S SDECI=SDECI+1
  1.  S ^TMP("SDEC",$J,SDECI)=$C(31)
  1.  Q
  1.  ;
  1. ETRAP ;EP Error trap entry
  1.  D ^%ZTER
  1.  I '$D(SDECI) N SDECI S SDECI=999999
  1.  S SDECI=SDECI+1
  1.  D ERR(SDECI,"SDEC08 Error")
  1.  Q