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