1 | SDCOU ;ALB/RMO - Utilities - Check Out;28 DEC 1992 10:00 am
|
---|
2 | ;;5.3;Scheduling;;Aug 13, 1993
|
---|
3 | ;
|
---|
4 | CODT(DFN,SDT,SDCL) ; -- does appt have co date
|
---|
5 | Q $P($G(^SC(SDCL,"S",SDT,1,+$$FIND^SDAM2(.DFN,.SDT,.SDCL),"C")),U,3)
|
---|
6 | ;
|
---|
7 | CHK(SDSEL) ;Check if Appt can be Checked Out
|
---|
8 | ; Input -- SDSEL Appt Selected in Appt Mgr
|
---|
9 | ; Output -- 1=Yes and 0=No
|
---|
10 | N SDAT,Y
|
---|
11 | S SDAT=$G(^TMP("SDAMIDX",$J,SDSEL)) G CHKQ:SDAT']""
|
---|
12 | S Y=1
|
---|
13 | 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
|
---|
14 | 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
|
---|
15 | CHKQ Q +$G(Y)
|
---|
16 | ;
|
---|
17 | STATUS(SDAT) ;Selected Appointment Status IEN
|
---|
18 | 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))
|
---|
19 | ;
|
---|
20 | ORG(SDORG) ;Originating Process Type Name for Outpatient Encounter
|
---|
21 | ; Input -- SDORG Originating Process Type
|
---|
22 | ; Output -- Originating Process Type Name
|
---|
23 | N Y
|
---|
24 | S Y=$$LOWER^VALM1($P($P(^DD(409.68,.08,0),SDORG_":",2),";"))
|
---|
25 | Q $G(Y)
|
---|
26 | ;
|
---|
27 | COMDT(SDOE) ;Check Out Process Completion Date/Time
|
---|
28 | Q $P($G(^SCE(+SDOE,0)),"^",7)
|
---|
29 | ;
|
---|
30 | SET(SDOE,SDNEW) ; -- set x-ref logic for co completion date to updates children
|
---|
31 | I '$D(^SCE("APAR",SDOE)) G SETQ
|
---|
32 | N SDOEP,SDOEC,X,DA,SDIX
|
---|
33 | S SDOEP=SDOE,SDOEC=0
|
---|
34 | F S SDOEC=$O(^SCE("APAR",SDOEP,SDOEC)) Q:'SDOEC D
|
---|
35 | .I $D(^SCE(SDOEC,0)) D
|
---|
36 | ..S $P(^SCE(SDOEC,0),U,7)=SDNEW,X=SDNEW,DA=SDOEC,SDIX=0
|
---|
37 | ..F S SDIX=$O(^DD(409.68,.07,1,SDIX)) Q:'SDIX X ^(SDIX,1) S X=SDNEW
|
---|
38 | SETQ Q
|
---|
39 | ;
|
---|
40 | KILL(SDOE,SDOLD) ; -- set x-ref logic for co completion date to updates children
|
---|
41 | I '$D(^SCE("APAR",SDOE)) G KILLQ
|
---|
42 | N SDOEP,SDOEC,X,DA,SDIX
|
---|
43 | S SDOEP=SDOE,SDOEC=0
|
---|
44 | F S SDOEC=$O(^SCE("APAR",SDOEP,SDOEC)) Q:'SDOEC D
|
---|
45 | .I $D(^SCE(SDOEC,0)) D
|
---|
46 | ..S $P(^SCE(SDOEC,0),U,7)="",X=SDOLD,DA=SDOEC,SDIX=0
|
---|
47 | ..F S SDIX=$O(^DD(409.68,.07,1,SDIX)) Q:'SDIX X ^(SDIX,2) S X=SDOLD
|
---|
48 | KILLQ Q
|
---|
49 | ;
|
---|