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  Sep 23, 2025@20:26                                                                                                                                                                                                          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       ;