SDEC25A ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
CO(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOACT,SDLNE,SDCOALBF,SDECAPTID,SDQUIET,VPRV,APIERR) ;Appt Check Out
; Input -- DFN Patient file IEN
; SDT Appointment Date/Time
; SDCL Hospital Location file IEN for Appt
; SDDA IEN in ^SC multiple or null [Optional]
; SDASK Ask Check Out Date/Time [Optional]
; SDCODT Date/Time of Check Out [Optional]
; SDCOACT Appt Mgmt Check Out Action [Optional]
; SDLNE Appt Mgmt Line Number [Optional]
; Output -- SDCOALBF Re-build Appt Mgmt List
; Input -- SDECAPTID Appointment ID
; SDQUIET No Terminal output 0=allow display 1=do not allow
; VPRV V Provider IEN - pointer to V PROVIDER file
N SDCOQUIT,SDOE,SDATA
N VALMBCK
S:'SDDA SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)
I 'SDDA D Q ; RETURN ERROR IF SDQUIET
. S APIERR=$G(APIERR)+1 S APIERR(APIERR)="SDCO1: Cannot check out this appointment - Hospital Location not identified."
. G COQ
S SDATA=$G(^DPT(DFN,"S",SDT,0))
; ** MT Blocking removed
;S X="EASMTCHK" X ^%ZOSF("TEST") I $T,$G(EASACT)'="W",$$MT^EASMTCHK(DFN,$P($G(SDATA),U,16),"C",$G(SDT)) D PAUSE^VALM1 G COQ
;
;-- if new encounter, pass to PCE
I $$NEW^SDPCE(SDT) D S VALMBCK="R",SDCOALBF=1 G COQ
. N SDCOED
. S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
. ;
. ; -- has appt already been checked out
. S SDCOED=$$CHK($TR($$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA),";","^"))
. ;
. D CO^SDEC25B(SDOE,DFN,SDT,SDCL,SDCODT,SDECAPTID,SDQUIET,VPRV,.APIERR) Q
;
COQ K % Q
;
;
;
CHK(SDSTB) ; -- is appointment checked out
N Y
I "^2^8^12^"[("^"_+SDSTB_"^"),$P(SDSTB,"^",3)["CHECKED OUT" S Y=1
Q +$G(Y)
;
DT(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOQUIT) ;Update Check Out Date
N %DT,DR,SDCIDT,X
S:'$D(^SC(SDCL,"S",0)) ^(0)="^44.001DA^^"
S DR="",SDCIDT=$P($G(^SC(SDCL,"S",SDT,1,SDDA,"C")),"^"),X=$P($G(^("C")),"^",3)
I X G DTQ:'SDASK S DR="303R"
I DR="",$P(^SC(SDCL,0),U,24),$$REQ^SDM1A(SDT)="CO" S DR="303R//"_$S($G(SDCODT):$$FTIME^VALM1($S(SDCODT<SDCIDT:SDCIDT,1:SDCODT)),1:"NOW")
I DR="" S DR="303R///"_$S($G(SDCODT):"/"_$S(SDCODT<SDCIDT:SDCIDT,1:SDCODT),1:"NOW")
S DR="S SDCOQUIT="""";"_DR_";K SDCOQUIT"
D DIE(SDCL,SDT,SDDA,DR)
DTQ Q
;
DIE(SDCL,SDT,SDDA,DR) ; -- update appt data in ^SC
N DA,DIE
S DA(2)=SDCL,DA(1)=SDT,DA=SDDA,DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,"
D ^DIE K DQ,DE
DIEQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC25A 2566 printed Apr 09, 2024@21:43:59 Page 2
SDEC25A ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
CO(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOACT,SDLNE,SDCOALBF,SDECAPTID,SDQUIET,VPRV,APIERR) ;Appt Check Out
+1 ; Input -- DFN Patient file IEN
+2 ; SDT Appointment Date/Time
+3 ; SDCL Hospital Location file IEN for Appt
+4 ; SDDA IEN in ^SC multiple or null [Optional]
+5 ; SDASK Ask Check Out Date/Time [Optional]
+6 ; SDCODT Date/Time of Check Out [Optional]
+7 ; SDCOACT Appt Mgmt Check Out Action [Optional]
+8 ; SDLNE Appt Mgmt Line Number [Optional]
+9 ; Output -- SDCOALBF Re-build Appt Mgmt List
+10 ; Input -- SDECAPTID Appointment ID
+11 ; SDQUIET No Terminal output 0=allow display 1=do not allow
+12 ; VPRV V Provider IEN - pointer to V PROVIDER file
+13 NEW SDCOQUIT,SDOE,SDATA
+14 NEW VALMBCK
+15 if 'SDDA
SET SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)
+16 ; RETURN ERROR IF SDQUIET
IF 'SDDA
Begin DoDot:1
+17 SET APIERR=$GET(APIERR)+1
SET APIERR(APIERR)="SDCO1: Cannot check out this appointment - Hospital Location not identified."
+18 GOTO COQ
End DoDot:1
QUIT
+19 SET SDATA=$GET(^DPT(DFN,"S",SDT,0))
+20 ; ** MT Blocking removed
+21 ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T,$G(EASACT)'="W",$$MT^EASMTCHK(DFN,$P($G(SDATA),U,16),"C",$G(SDT)) D PAUSE^VALM1 G COQ
+22 ;
+23 ;-- if new encounter, pass to PCE
+24 IF $$NEW^SDPCE(SDT)
Begin DoDot:1
+25 NEW SDCOED
+26 SET SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
+27 ;
+28 ; -- has appt already been checked out
+29 SET SDCOED=$$CHK($TRANSLATE($$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA),";","^"))
+30 ;
+31 DO CO^SDEC25B(SDOE,DFN,SDT,SDCL,SDCODT,SDECAPTID,SDQUIET,VPRV,.APIERR)
QUIT
End DoDot:1
SET VALMBCK="R"
SET SDCOALBF=1
GOTO COQ
+32 ;
COQ KILL %
QUIT
+1 ;
+2 ;
+3 ;
CHK(SDSTB) ; -- is appointment checked out
+1 NEW Y
+2 IF "^2^8^12^"[("^"_+SDSTB_"^")
IF $PIECE(SDSTB,"^",3)["CHECKED OUT"
SET Y=1
+3 QUIT +$GET(Y)
+4 ;
DT(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOQUIT) ;Update Check Out Date
+1 NEW %DT,DR,SDCIDT,X
+2 if '$DATA(^SC(SDCL,"S",0))
SET ^(0)="^44.001DA^^"
+3 SET DR=""
SET SDCIDT=$PIECE($GET(^SC(SDCL,"S",SDT,1,SDDA,"C")),"^")
SET X=$PIECE($GET(^("C")),"^",3)
+4 IF X
if 'SDASK
GOTO DTQ
SET DR="303R"
+5 IF DR=""
IF $PIECE(^SC(SDCL,0),U,24)
IF $$REQ^SDM1A(SDT)="CO"
SET DR="303R//"_$SELECT($GET(SDCODT):$$FTIME^VALM1($SELECT(SDCODT<SDCIDT:SDCIDT,1:SDCODT)),1:"NOW")
+6 IF DR=""
SET DR="303R///"_$SELECT($GET(SDCODT):"/"_$SELECT(SDCODT<SDCIDT:SDCIDT,1:SDCODT),1:"NOW")
+7 SET DR="S SDCOQUIT="""";"_DR_";K SDCOQUIT"
+8 DO DIE(SDCL,SDT,SDDA,DR)
DTQ QUIT
+1 ;
DIE(SDCL,SDT,SDDA,DR) ; -- update appt data in ^SC
+1 NEW DA,DIE
+2 SET DA(2)=SDCL
SET DA(1)=SDT
SET DA=SDDA
SET DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,"
+3 DO ^DIE
KILL DQ,DE
DIEQ QUIT
