source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDUTL1.m@ 1270

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1SDUTL1 ;ALB/MJK - Scheduling Utilities; 12/1/91
2 ;;5.3;Scheduling;;Aug 13, 1993
3 ;
4ENROL(DFN,SDCL) ;
5 S SDY=$$CHK(.DFN,.SDCL,1) G ENROLQ:SDY
6 S SDY=$$ASK G ENROLQ:SDY<0
7 I SDY=1 S SDY=$$DIE(.DFN,.SDCL) G ENROLQ
8 I SDY=0 S SDY=$$CON
9ENROLQ Q SDY
10 ;
11CHK(DFN,SDCL,SHOW) ;
12 N SDPRCL,CL,SDE,SDJ,DIS,SDY,SDATA
13 S SDY=0,SDPRCL=$$PRIN(.SDCL)
14 S SDE=0 F S SDE=$O(^DPT(DFN,"DE",SDE)) Q:'SDE S CL=+$G(^(SDE,0)) I CL=SDCL!(CL=SDPRCL) D G CHKQ:SDY
15 .S SDJ=0 F S SDJ=$O(^DPT(DFN,"DE",SDE,1,SDJ)) Q:'SDJ S SDATA=$G(^(SDJ,0)) D:$D(SHOW) SHOW(.SDATA) S:'$P(SDATA,U,3) SDY=1
16CHKQ Q SDY
17 ;
18ASK() ;
19 S DIR(0)="Y",DIR("A")="Do you wish to enroll the patient" D ^DIR K DIR
20 S SDY=$S($D(DIRUT):-1,1:Y) K DIRUT
21ASKQ Q SDY
22 ;
23CON() ;
24 S DIR(0)="Y",DIR("A")="Do you wish to schedule patient for a consult" D ^DIR K DIR
25 Q Y
26 ;
27DIE(DFN,SDCL) ;
28 N SDPRCL,SDFILE,SDE
29 S SDPRCL=$$PRIN(.SDCL)
30 S SDE=0 F S SDE=$O(^DPT(DFN,"DE",SDE)) Q:'SDE Q:SDPRCL=+$G(^(SDE,0))
31FILE I 'SDE K D0,DD S:'$D(^DPT(DFN,"DE",0)) $P(^DPT(DFN,"DE",0),U,2)=$P(^DD(2,3,0),U,2) S X=SDPRCL,DA(1)=DFN,DIC(0)="L",DIC="^DPT("_DA(1)_",""DE""," D FILE^DICN K DIC,DD,D0 G FILE:Y<1 S SDE=+Y,SDFILE=""
32DATE R !,?10,"DATE OF ENROLLMENT: NOW// ",X:DTIME
33 I X["^" D:$D(SDFILE) DIK(.DFN,.SDE) G DIEQ
34 S:X="" X="NOW" S %DT="EXT" D ^%DT G:Y<0 DATE
35 S:'$D(^DPT(DFN,"DE",SDE,1,0)) $P(^DPT(DFN,"DE",SDE,1,0),U,2)=$P(^DD(2.001,1,0),U,2)
36 K DO,DD S X=Y,DA(2)=DFN,DA(1)=SDE,DIC("DR")=1,DIC="^DPT("_DA(2)_",""DE"","_DA(1)_",1,",DIC(0)="L" D FILE^DICN K DIC,DD,D0
37 I Y<1,$D(SDFILE) D DIK(.DFN,.SDE)
38 K DIK,DA
39DIEQ Q $$CHK(.DFN,.SDCL)
40 ;
41DIK(DFN,SDE) ;
42 N DA,DIK
43 S DA(1)=DFN,DA=SDE,DIK="^DPT("_DA(1)_",""DE""," D ^DIK
44 Q
45 ;
46PRIN(CLINIC) ;
47 N PRIN
48 S PRIN=+$P($G(^SC(CLINIC,"SL")),U,5)
49 Q $S($D(^SC(PRIN,0)):PRIN,1:CLINIC)
50 ;
51SHOW(SDATA) ;
52 N SDDIS S SDDIS=$P(SDATA,U,3)
53 W !,$S('SDDIS:"Current ",1:"Previous "),"Enrollment: ",$S($P(SDATA,U,2)["O":"OPT",1:"AC")
54 I SDDIS W ?41,"Discharged from clinic: ",$$FTIME^VALM1(SDDIS)
55 Q
56 ;
57TEST ;
58 S Y=$$ENROL(1,317)
59 W !!,Y
Note: See TracBrowser for help on using the repository browser.