- 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 ;
