source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDCO.m@ 1446

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

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1SDCO ;ALB/RMO - Check Out List Manager Driver; 11 FEB 1993 10:00 am
2 ;;5.3;Scheduling;**27,132,149,193**;08/13/93
3 ;
4EN(SDOE,SDCOHDL,SDCOXQB) ; -- main entry point for SDCO CHECK OUT list manager
5 ; Input -- SDOE, SDCOHDL and SDCOXQB [Optional]
6 N SDCOACT,SDEVTF,SDAPTYP
7 IF $P($G(^SCE(+SDOE,0)),"^",6) G ENQ ;exit if child
8 D EN^VALM("SDCO CHECK OUT")
9ENQ ;
10 Q
11 ;
12HDR ; -- header code
13 K VALMHDR
14 N DFN,SDCL,SDOE0,X,VA,SDELIG,SDATA
15 S SDOE0=$G(^SCE(+SDOE,0)),SDCL=+$P(SDOE0,"^",4)
16 S DFN=+$P(SDOE0,"^",2) D PID^VADPT
17 I $G(SDT)'="" S SDATA=$G(^DPT(DFN,"S",SDT,0))
18 S SDELIG=$$ELSTAT^SDUTL2(DFN)
19 I $$MHCLIN^SDUTL2(SDCL),'($$COLLAT^SDUTL2(SDELIG)!$P($G(SDATA),U,11)) D
20 .S SDGAF=$$NEWGAF^SDUTL2(DFN),SDGAFST=$P(SDGAF,"^")
21 .I SDGAFST D
22 ..S SDGAFDT=$$FMTE^XLFDT($P(SDGAF,"^",3),"5M"),SDGAFS=$P(SDGAF,"^",2),SDGAFP=$P(SDGAF,"^",4)
23 ..S VALMHDR(3)="GAF Date: "_SDGAFDT_" GAF Score: "_SDGAFS_" New GAF Required"
24 S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),"^"),1,30)_" ("_VA("BID")_")"
25 S:SDCL VALMHDR(1)=$$SETSTR^VALM1($E("Clinic: "_$P($G(^SC(SDCL,0)),"^"),1,20),VALMHDR(1),60,80)
26 S VALMHDR(2)=$$SETSTR^VALM1($E($$ORG^SDCOU(+$P(SDOE0,"^",8)),1,20)_" Date/Time: "_$$LOWER^VALM1($$FTIME^VALM1(+SDOE0)),"",1,51)
27 S VALMHDR(2)=$$SETSTR^VALM1("Checked Out: "_$S($$COMDT^SDCOU(SDOE):"YES",1:"NO"),VALMHDR(2),60,80)
28 Q
29 ;
30INIT ; -- init variables and list array -- SDOE required
31 D BLD
32 Q
33 ;
34BLD ; -- build check out screen
35 D CLEAN^VALM10
36 K ^TMP("SDCOIDX")
37 D HDR
38 D EN^SDCO0("SDCO",SDOE,1,.VALMCNT)
39 Q
40 ;
41HELP ; -- help code
42 S X="?" D DISP^XQORM1 W !!
43 Q
44 ;
45EXIT ; -- exit code
46 D CLEAN^VALM10,CLEAR^VALM1
47 K ^TMP("SDCOIDX"),SDCOXQB
48 Q
49 ;
50EXPND ; -- expand code
51 Q
52 ;
Note: See TracBrowser for help on using the repository browser.