SDCOU ;ALB/RMO - Utilities - Check Out;28 DEC 1992 10:00 am ;01/21/2015
;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
;
;Private ICR
; 6167 - READ ACCESS TO DD(409.68
;
CODT(DFN,SDT,SDCL) ; -- does appt have co date
Q $P($G(^SC(SDCL,"S",SDT,1,+$$FIND^SDAM2(.DFN,.SDT,.SDCL),"C")),U,3)
;
CHK(SDSEL) ;Check if Appt can be Checked Out
; Input -- SDSEL Appt Selected in Appt Mgr
; Output -- 1=Yes and 0=No
N SDAT,Y
S SDAT=$G(^TMP("SDAMIDX",$J,SDSEL)) G CHKQ:SDAT']""
S Y=1
I '$D(^SD(409.63,"ACO",1,$$STATUS(SDAT))) W !!,*7,">>> You can not check out this appointment." D PAUSE^VALM1 S Y=0 G CHKQ
I $P(+$P(SDAT,"^",3),".")>DT W !!,*7,">>> It is too soon to check out this appointment." D PAUSE^VALM1 S Y=0 G CHKQ
CHKQ Q +$G(Y)
;
STATUS(SDAT) ;Selected Appointment Status IEN
Q +$$STATUS^SDAM1(+$P(SDAT,"^",2),+$P(SDAT,"^",3),+$P(SDAT,"^",4),$G(^DPT(+$P(SDAT,"^",2),"S",+$P(SDAT,"^",3),0)),+$P(SDAT,"^",5))
;
ORG(SDORG) ;Originating Process Type Name for Outpatient Encounter
; Input -- SDORG Originating Process Type
; Output -- Originating Process Type Name
;ICR 6167 - READ ACCESS TO DD(409.68
N Y
S Y=$$LOWER^VALM1($P($P(^DD(409.68,.08,0),SDORG_":",2),";"))
Q $G(Y)
;
COMDT(SDOE) ;Check Out Process Completion Date/Time
Q $P($G(^SCE(+SDOE,0)),"^",7)
;
SET(SDOE,SDNEW) ; -- set x-ref logic for co completion date to update children
I '$D(^SCE("APAR",SDOE)) G SETQ
N SDOEC,SDFDA
S SDOEC=0 F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC D
.I $D(^SCE(SDOE,0)) D
..K SDFDA
..S SDFDA(409.68,SDOEC_",",.07)=SDNEW
..D FILE^DIE("","SDFDA")
SETQ Q
;
KILL(SDOE,SDOLD) ; -- set x-ref logic for co completion date to update children
I '$D(^SCE("APAR",SDOE)) G KILLQ
N SDOEC,SDFDA
S SDOEC=0 F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC D
.I $D(^SCE(SDOE,0)) D
..K SDFDA
..S SDFDA(409.68,SDOEC_",",.07)=""
..D FILE^DIE("","SDFDA")
KILLQ Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCOU 1934 printed Apr 09, 2024@21:49:07 Page 2
SDCOU ;ALB/RMO - Utilities - Check Out;28 DEC 1992 10:00 am ;01/21/2015
+1 ;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
+2 ;
+3 ;Private ICR
+4 ; 6167 - READ ACCESS TO DD(409.68
+5 ;
CODT(DFN,SDT,SDCL) ; -- does appt have co date
+1 QUIT $PIECE($GET(^SC(SDCL,"S",SDT,1,+$$FIND^SDAM2(.DFN,.SDT,.SDCL),"C")),U,3)
+2 ;
CHK(SDSEL) ;Check if Appt can be Checked Out
+1 ; Input -- SDSEL Appt Selected in Appt Mgr
+2 ; Output -- 1=Yes and 0=No
+3 NEW SDAT,Y
+4 SET SDAT=$GET(^TMP("SDAMIDX",$JOB,SDSEL))
if SDAT']""
GOTO CHKQ
+5 SET Y=1
+6 IF '$DATA(^SD(409.63,"ACO",1,$$STATUS(SDAT)))
WRITE !!,*7,">>> You can not check out this appointment."
DO PAUSE^VALM1
SET Y=0
GOTO CHKQ
+7 IF $PIECE(+$PIECE(SDAT,"^",3),".")>DT
WRITE !!,*7,">>> It is too soon to check out this appointment."
DO PAUSE^VALM1
SET Y=0
GOTO CHKQ
CHKQ QUIT +$GET(Y)
+1 ;
STATUS(SDAT) ;Selected Appointment Status IEN
+1 QUIT +$$STATUS^SDAM1(+$PIECE(SDAT,"^",2),+$PIECE(SDAT,"^",3),+$PIECE(SDAT,"^",4),$GET(^DPT(+$PIECE(SDAT,"^",2),"S",+$PIECE(SDAT,"^",3),0)),+$PIECE(SDAT,"^",5))
+2 ;
ORG(SDORG) ;Originating Process Type Name for Outpatient Encounter
+1 ; Input -- SDORG Originating Process Type
+2 ; Output -- Originating Process Type Name
+3 ;ICR 6167 - READ ACCESS TO DD(409.68
+4 NEW Y
+5 SET Y=$$LOWER^VALM1($PIECE($PIECE(^DD(409.68,.08,0),SDORG_":",2),";"))
+6 QUIT $GET(Y)
+7 ;
COMDT(SDOE) ;Check Out Process Completion Date/Time
+1 QUIT $PIECE($GET(^SCE(+SDOE,0)),"^",7)
+2 ;
SET(SDOE,SDNEW) ; -- set x-ref logic for co completion date to update children
+1 IF '$DATA(^SCE("APAR",SDOE))
GOTO SETQ
+2 NEW SDOEC,SDFDA
+3 SET SDOEC=0
FOR
SET SDOEC=$ORDER(^SCE("APAR",SDOE,SDOEC))
if 'SDOEC
QUIT
Begin DoDot:1
+4 IF $DATA(^SCE(SDOE,0))
Begin DoDot:2
+5 KILL SDFDA
+6 SET SDFDA(409.68,SDOEC_",",.07)=SDNEW
+7 DO FILE^DIE("","SDFDA")
End DoDot:2
End DoDot:1
SETQ QUIT
+1 ;
KILL(SDOE,SDOLD) ; -- set x-ref logic for co completion date to update children
+1 IF '$DATA(^SCE("APAR",SDOE))
GOTO KILLQ
+2 NEW SDOEC,SDFDA
+3 SET SDOEC=0
FOR
SET SDOEC=$ORDER(^SCE("APAR",SDOE,SDOEC))
if 'SDOEC
QUIT
Begin DoDot:1
+4 IF $DATA(^SCE(SDOE,0))
Begin DoDot:2
+5 KILL SDFDA
+6 SET SDFDA(409.68,SDOEC_",",.07)=""
+7 DO FILE^DIE("","SDFDA")
End DoDot:2
End DoDot:1
KILLQ QUIT
+1 ;
