| [613] | 1 | SDCO ;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 | ;
|
|---|
| 4 | EN(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")
|
|---|
| 9 | ENQ ;
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | HDR ; -- 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 | ;
|
|---|
| 30 | INIT ; -- init variables and list array -- SDOE required
|
|---|
| 31 | D BLD
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | BLD ; -- 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 | ;
|
|---|
| 41 | HELP ; -- help code
|
|---|
| 42 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | EXIT ; -- exit code
|
|---|
| 46 | D CLEAN^VALM10,CLEAR^VALM1
|
|---|
| 47 | K ^TMP("SDCOIDX"),SDCOXQB
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | EXPND ; -- expand code
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
