source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDCO7.m@ 1147

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1SDCO7 ;ALB/RMO - Miscellaneous Actions - Check Out; 14 APR 1993 10:00 am
2 ;;5.3;Scheduling;**132,149,175,193**;Aug 13, 1993
3 ;
4CD ;Entry point for SDCO DATE CHANGE protocol
5 ; Input -- SDOE
6 N DFN,SDCL,SDCOQUIT,SDDA,SDOE0,SDORG,SDT
7 S VALMBCK=""
8 ;
9 ; -- if OLD encounter, quit
10 IF '$$EDITOK^SDCO3($G(SDOE),1) G CDQ
11 ;
12 S SDOE0=$G(^SCE(+SDOE,0)),SDT=+^(0),DFN=+$P(SDOE0,"^",2),SDCL=+$P(SDOE0,"^",4),SDORG=+$P(SDOE0,"^",8),SDDA=+$P(SDOE0,"^",9)
13 I SDORG'=1 W !!,*7,">>> Only appointments have a check out date to edit." D PAUSE^VALM1 G CDQ
14 I '$P($G(^SC(SDCL,"S",SDT,1,SDDA,"C")),"^",3) W !!,*7,">>> No check out date for this appointment." D PAUSE^VALM1 G CDQ
15 D DT^SDCO1(DFN,SDT,SDCL,SDDA,1,.SDCOQUIT)
16 S VALMBCK="R"
17CDQ Q
18 ;
19PD ;Entry point for SDCO PATIENT DEMOGRAPHICS protocol
20 ; Input -- SDOE
21 S VALMBCK=""
22 D FULL^VALM1
23 W !!,VALMHDR(1),!
24 D DEM^SDCOAM(+$P($G(^SCE(+SDOE,0)),"^",2))
25 S VALMBCK="R"
26PDQ Q
27 ;
28DC ;Entry point for SDCO DISCHARGE CLINIC protocol
29 ; Input -- SDOE
30 N DFN,SDCLN,SDFN,SDOE0
31 S VALMBCK=""
32 S SDOE0=$G(^SCE(+SDOE,0)),SDFN=+$P(SDOE0,"^",2)
33 S:$P(SDOE0,"^",4) SDCLN=+$P(SDOE0,"^",4)
34 D FULL^VALM1
35 W !!,VALMHDR(1),!
36 D DIS^SDCOAM(SDFN,$G(SDCLN))
37 S VALMBCK="R"
38DCQ Q
39 ;
40GAF ;Entry point for SDCO GAF protocol
41 ;Input -- SDOE
42 S VALMBCK=""
43 D FULL^VALM1
44 W !!
45 N DFN,SDCL,SDELIG
46 S DFN=+$P($G(^SCE(+SDOE,0)),"^",2)
47 S SDCL=+$P($G(^SCE(+SDOE,0)),"^",4)
48 S SDATA=$G(^DPT(DFN,"S",SDT,0))
49 S SDELIG=$$ELSTAT^SDUTL2(DFN)
50 ;
51 I '$$MHCLIN^SDUTL2(SDCL)!($$COLLAT^SDUTL2(SDELIG))!($P(SDATA,U,11)) D S VALMBCK="R" Q
52 . S DIR(0)="FAO"
53 . S DIR("A",1)="A GAF Score is not applicable to this appointment!"
54 . S DIR("A")="Press any key to continue"
55 . D ^DIR K DIR
56 ;
57 N SDGSCR S SDGSCR=$$NEWGAF^SDUTL2(DFN)
58 I +$P(SDGSCR,U,5)>0 W !,"Warning: Patient is deceased."
59 I '+SDGSCR D
60 . W !,"Current GAF: "_+$P(SDGSCR,U,2)
61 . W $S($P(SDGSCR,U,3)>0:", from "_$$FMTE^XLFDT($P(SDGSCR,U,3),"D"),1:", Date Unavailable")
62 ;
63 D EN^SDGAF(DFN)
64 D HDR^SDCO ; reset header after entering new GAF score
65 S VALMBCK="R"
66GAFQ Q
Note: See TracBrowser for help on using the repository browser.