source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDCOU.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1SDCOU ;ALB/RMO - Utilities - Check Out;28 DEC 1992 10:00 am
2 ;;5.3;Scheduling;;Aug 13, 1993
3 ;
4CODT(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 ;
7CHK(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
15CHKQ Q +$G(Y)
16 ;
17STATUS(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 ;
20ORG(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 ;
27COMDT(SDOE) ;Check Out Process Completion Date/Time
28 Q $P($G(^SCE(+SDOE,0)),"^",7)
29 ;
30SET(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
38SETQ Q
39 ;
40KILL(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
48KILLQ Q
49 ;
Note: See TracBrowser for help on using the repository browser.