SDCOU ;ALB/RMO - Utilities - Check Out;28 DEC 1992 10:00 am
;;5.3;Scheduling;**1012,1015**;Aug 13, 1993;Build 21
;cmi/flag/maw - 06/02/2010 PATCH 1012 RQMT149 added check of list view
;
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 $P(SDAT,U,6)]"" W !!,*7,">>> This is not a valid appointment." D PAUSE^VALM1 S Y=0 G CHKQ ;cmi/maw 6/2/2010 PATCH 1012 for list view
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
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 updates children
I '$D(^SCE("APAR",SDOE)) G SETQ
N SDOEP,SDOEC,X,DA,SDIX
S SDOEP=SDOE,SDOEC=0
F S SDOEC=$O(^SCE("APAR",SDOEP,SDOEC)) Q:'SDOEC D
.I $D(^SCE(SDOEC,0)) D
..S $P(^SCE(SDOEC,0),U,7)=SDNEW,X=SDNEW,DA=SDOEC,SDIX=0
..F S SDIX=$O(^DD(409.68,.07,1,SDIX)) Q:'SDIX X ^(SDIX,1) S X=SDNEW
SETQ Q
;
KILL(SDOE,SDOLD) ; -- set x-ref logic for co completion date to updates children
I '$D(^SCE("APAR",SDOE)) G KILLQ
N SDOEP,SDOEC,X,DA,SDIX
S SDOEP=SDOE,SDOEC=0
F S SDOEC=$O(^SCE("APAR",SDOEP,SDOEC)) Q:'SDOEC D
.I $D(^SCE(SDOEC,0)) D
..S $P(^SCE(SDOEC,0),U,7)="",X=SDOLD,DA=SDOEC,SDIX=0
..F S SDIX=$O(^DD(409.68,.07,1,SDIX)) Q:'SDIX X ^(SDIX,2) S X=SDOLD
KILLQ Q
;
SDCOU ;ALB/RMO - Utilities - Check Out;28 DEC 1992 10:00 am
+1 ;;5.3;Scheduling;**1012,1015**;Aug 13, 1993;Build 21
+2 ;cmi/flag/maw - 06/02/2010 PATCH 1012 RQMT149 added check of list view
+3 ;
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 ;cmi/maw 6/2/2010 PATCH 1012 for list view
IF $PIECE(SDAT,U,6)]""
WRITE !!,*7,">>> This is not a valid appointment."
DO PAUSE^VALM1
SET Y=0
GOTO CHKQ
+7 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
+8 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 NEW Y
+4 SET Y=$$LOWER^VALM1($PIECE($PIECE(^DD(409.68,.08,0),SDORG_":",2),";"))
+5 QUIT $GET(Y)
+6 ;
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 updates children
+1 IF '$DATA(^SCE("APAR",SDOE))
GOTO SETQ
+2 NEW SDOEP,SDOEC,X,DA,SDIX
+3 SET SDOEP=SDOE
SET SDOEC=0
+4 FOR
SET SDOEC=$ORDER(^SCE("APAR",SDOEP,SDOEC))
IF 'SDOEC
QUIT
Begin DoDot:1
+5 IF $DATA(^SCE(SDOEC,0))
Begin DoDot:2
+6 SET $PIECE(^SCE(SDOEC,0),U,7)=SDNEW
SET X=SDNEW
SET DA=SDOEC
SET SDIX=0
+7 FOR
SET SDIX=$ORDER(^DD(409.68,.07,1,SDIX))
IF 'SDIX
QUIT
XECUTE ^(SDIX,1)
SET X=SDNEW
End DoDot:2
End DoDot:1
SETQ QUIT
+1 ;
KILL(SDOE,SDOLD) ; -- set x-ref logic for co completion date to updates children
+1 IF '$DATA(^SCE("APAR",SDOE))
GOTO KILLQ
+2 NEW SDOEP,SDOEC,X,DA,SDIX
+3 SET SDOEP=SDOE
SET SDOEC=0
+4 FOR
SET SDOEC=$ORDER(^SCE("APAR",SDOEP,SDOEC))
IF 'SDOEC
QUIT
Begin DoDot:1
+5 IF $DATA(^SCE(SDOEC,0))
Begin DoDot:2
+6 SET $PIECE(^SCE(SDOEC,0),U,7)=""
SET X=SDOLD
SET DA=SDOEC
SET SDIX=0
+7 FOR
SET SDIX=$ORDER(^DD(409.68,.07,1,SDIX))
IF 'SDIX
QUIT
XECUTE ^(SDIX,2)
SET X=SDOLD
End DoDot:2
End DoDot:1
KILLQ QUIT
+1 ;
