VistA-Scheduling/kids/sd0530_11310.k

459 lines
11 KiB
Plaintext

KIDS Distribution saved on Jul 25, 2009@19:02:20
Modified SDAMEVT routine to enable BSDX scheduling
**KIDS**:SD*5.3*11310^
**INSTALL NAME**
SD*5.3*11310
"BLD",7417,0)
SD*5.3*11310^SCHEDULING^0^3090725^n
"BLD",7417,4,0)
^9.64PA^^
"BLD",7417,6.3)
2
"BLD",7417,"KRN",0)
^9.67PA^8989.52^19
"BLD",7417,"KRN",.4,0)
.4
"BLD",7417,"KRN",.401,0)
.401
"BLD",7417,"KRN",.402,0)
.402
"BLD",7417,"KRN",.403,0)
.403
"BLD",7417,"KRN",.5,0)
.5
"BLD",7417,"KRN",.84,0)
.84
"BLD",7417,"KRN",3.6,0)
3.6
"BLD",7417,"KRN",3.8,0)
3.8
"BLD",7417,"KRN",9.2,0)
9.2
"BLD",7417,"KRN",9.8,0)
9.8
"BLD",7417,"KRN",9.8,"NM",0)
^9.68A^1^1
"BLD",7417,"KRN",9.8,"NM",1,0)
SDAMEVT^^0^B29013195
"BLD",7417,"KRN",9.8,"NM","B","SDAMEVT",1)
"BLD",7417,"KRN",19,0)
19
"BLD",7417,"KRN",19.1,0)
19.1
"BLD",7417,"KRN",101,0)
101
"BLD",7417,"KRN",409.61,0)
409.61
"BLD",7417,"KRN",771,0)
771
"BLD",7417,"KRN",870,0)
870
"BLD",7417,"KRN",8989.51,0)
8989.51
"BLD",7417,"KRN",8989.52,0)
8989.52
"BLD",7417,"KRN",8994,0)
8994
"BLD",7417,"KRN","B",.4,.4)
"BLD",7417,"KRN","B",.401,.401)
"BLD",7417,"KRN","B",.402,.402)
"BLD",7417,"KRN","B",.403,.403)
"BLD",7417,"KRN","B",.5,.5)
"BLD",7417,"KRN","B",.84,.84)
"BLD",7417,"KRN","B",3.6,3.6)
"BLD",7417,"KRN","B",3.8,3.8)
"BLD",7417,"KRN","B",9.2,9.2)
"BLD",7417,"KRN","B",9.8,9.8)
"BLD",7417,"KRN","B",19,19)
"BLD",7417,"KRN","B",19.1,19.1)
"BLD",7417,"KRN","B",101,101)
"BLD",7417,"KRN","B",409.61,409.61)
"BLD",7417,"KRN","B",771,771)
"BLD",7417,"KRN","B",870,870)
"BLD",7417,"KRN","B",8989.51,8989.51)
"BLD",7417,"KRN","B",8989.52,8989.52)
"BLD",7417,"KRN","B",8994,8994)
"MBREQ")
0
"PKG",48,-1)
1^1
"PKG",48,0)
SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS
"PKG",48,22,0)
^9.49I^1^1
"PKG",48,22,1,0)
5.3^3040324^2960613
"PKG",48,22,1,"PAH",1,0)
11310^3090725
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")
"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
1
"RTN","SDAMEVT")
0^1^B29013195
"RTN","SDAMEVT",1,0)
SDAMEVT ;ALB/MJK - Appt Event Driver Utilities ; 12/1/91 [ 09/19/96 1:39 PM ]
"RTN","SDAMEVT",2,0)
;;5.3;Scheduling;**15,132,443,local**;Aug 13, 1993;Build 2
"RTN","SDAMEVT",3,0)
; localmods by WV/SMH;
"RTN","SDAMEVT",4,0)
;
"RTN","SDAMEVT",5,0)
BEFORE(SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ; -- get before values
"RTN","SDAMEVT",6,0)
K ^TMP("SDAMEVT",$J)
"RTN","SDAMEVT",7,0)
D CAPTURE("BEFORE",.SDATA,.DFN,.SDT,.SDCL,.SDDA,.SDHDL)
"RTN","SDAMEVT",8,0)
Q
"RTN","SDAMEVT",9,0)
;
"RTN","SDAMEVT",10,0)
AFTER(SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ; -- get after values
"RTN","SDAMEVT",11,0)
D CAPTURE("AFTER",.SDATA,.DFN,.SDT,.SDCL,.SDDA,.SDHDL)
"RTN","SDAMEVT",12,0)
Q
"RTN","SDAMEVT",13,0)
;
"RTN","SDAMEVT",14,0)
HANDLE(SDORG) ; -- get evt handle
"RTN","SDAMEVT",15,0)
; SDORG = originating process (1=appt , 2=a/e , 3=disp)
"RTN","SDAMEVT",16,0)
S (Y,^($J))=$G(^TMP("SDEVT HANDLE",$J))+1
"RTN","SDAMEVT",17,0)
Q Y
"RTN","SDAMEVT",18,0)
;
"RTN","SDAMEVT",19,0)
CLEAN(SDHDL) ;
"RTN","SDAMEVT",20,0)
K ^TMP("SDEVT",$J,SDHDL)
"RTN","SDAMEVT",21,0)
Q
"RTN","SDAMEVT",22,0)
;
"RTN","SDAMEVT",23,0)
HDLKILL ; -- kill off handle data
"RTN","SDAMEVT",24,0)
K SDHDL,^TMP("SDEVT HANDLE",$J),^TMP("SDEVT",$J)
"RTN","SDAMEVT",25,0)
Q
"RTN","SDAMEVT",26,0)
;
"RTN","SDAMEVT",27,0)
CAPTURE(SDCAP,SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ;
"RTN","SDAMEVT",28,0)
N Z
"RTN","SDAMEVT",29,0)
S (Z,^TMP("SDAMEVT",$J,SDCAP,"DPT"),^TMP("SDEVT",$J,SDHDL,1,"DPT",0,SDCAP))=$G(^DPT(DFN,"S",SDT,0))
"RTN","SDAMEVT",30,0)
S (^TMP("SDAMEVT",$J,SDCAP,"SC"),^TMP("SDEVT",$J,SDHDL,1,"SC",0,SDCAP))=$G(^SC(SDCL,"S",SDT,1,+SDDA,0))
"RTN","SDAMEVT",31,0)
S (^TMP("SDAMEVT",$J,SDCAP,"STATUS"),SDATA(SDCAP,"STATUS"))=$TR($$STATUS^SDAM1(DFN,SDT,SDCL,Z,SDDA),";","^")
"RTN","SDAMEVT",32,0)
D:$P(Z,U,20) OE(.SDCAP,1,$P(Z,U,20),.SDHDL)
"RTN","SDAMEVT",33,0)
Q
"RTN","SDAMEVT",34,0)
;
"RTN","SDAMEVT",35,0)
;
"RTN","SDAMEVT",36,0)
EVT(SDATA,SDAMEVT,SDMODE,SDHDL) ; -- calls the sdam event protocol
"RTN","SDAMEVT",37,0)
N OROLD
"RTN","SDAMEVT",38,0)
K DTOUT,DIROUT
"RTN","SDAMEVT",39,0)
I $G(SDATA("BEFORE","STATUS"))=$G(SDATA("AFTER","STATUS")),'$$COMP^SDAMEVT4(SDHDL,SDAMEVT) G EVTQ ; SD*5.3*443
"RTN","SDAMEVT",40,0)
S:$P(SDATA,U,3) $P(SDATA,U,5)=$$REQ^SDM1A(+$P(SDATA,U,3))
"RTN","SDAMEVT",41,0)
S X=+$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))_";ORD(101,"
"RTN","SDAMEVT",42,0)
D EN^XQOR
"RTN","SDAMEVT",43,0)
EVTQ K XQORPOP,X,^TMP("SDAMEVT",$J) D CLEAN(SDHDL) Q
"RTN","SDAMEVT",44,0)
;
"RTN","SDAMEVT",45,0)
;
"RTN","SDAMEVT",46,0)
MAKE(DFN,SDT,SDCL,SDDA,SDMODE) ; -- make appt event #1
"RTN","SDAMEVT",47,0)
N SDATA,%,SDMKHDL,SDHDL K ^TMP("SDAMEVT",$J)
"RTN","SDAMEVT",48,0)
S SDMKHDL=$$HANDLE(1)
"RTN","SDAMEVT",49,0)
S (^TMP("SDAMEVT",$J,"BEFORE","DPT"),^TMP("SDAMEVT",$J,"BEFORE","SC"),SDATA("BEFORE","STATUS"),^TMP("SDAMEVT",$J,"BEFORE","STATUS"),^TMP("SDEVT",$J,SDMKHDL,1,"DPT",0,"BEFORE"),^TMP("SDEVT",$J,SDMKHDL,1,"SC",0,"BEFORE"))=""
"RTN","SDAMEVT",50,0)
D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
"RTN","SDAMEVT",51,0)
S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","SDAMEVT",52,0)
; D EVT(.SDATA,1,+$G(SDAMODE),SDMKHDL) ; wrong line
"RTN","SDAMEVT",53,0)
D EVT(.SDATA,1,+$G(SDMODE),SDMKHDL) ; //smh SDMODE was misspelt
"RTN","SDAMEVT",54,0)
; -- if appt d/t is less than NOW then check-in
"RTN","SDAMEVT",55,0)
D NOW^%DTC
"RTN","SDAMEVT",56,0)
; I SDT<% W:'$G(SDMODE) ! D //smh
"RTN","SDAMEVT",57,0)
I SDT<%,$G(SDMODE)<2 D ; but only ask if you are in interactive mode. If SDMODE=2, don't ask.
"RTN","SDAMEVT",58,0)
.N SDACT,SDCOQUIT
"RTN","SDAMEVT",59,0)
.S SDDA=+SDATA,DFN=$P(SDATA,U,2),SDT=$P(SDATA,U,3),SDCL=$P(SDATA,U,4) K SDATA
"RTN","SDAMEVT",60,0)
.I $$REQ^SDM1A(SDT)="CO",'$G(SDCOACT) D
"RTN","SDAMEVT",61,0)
..S SDACT=$S(SDT<DT:"CO",1:$$ASK^SDAMEX) I SDACT']"" S SDCOQUIT=1 Q
"RTN","SDAMEVT",62,0)
..I SDACT="CO" D CO^SDCO1(DFN,SDT,SDCL,SDDA,0,SDT)
"RTN","SDAMEVT",63,0)
.I '$G(SDCOQUIT),$G(SDACT)'="CO" D ONE^SDAM2(DFN,SDCL,SDT,SDDA,0,SDT)
"RTN","SDAMEVT",64,0)
Q
"RTN","SDAMEVT",65,0)
;
"RTN","SDAMEVT",66,0)
;
"RTN","SDAMEVT",67,0)
CANCEL(SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDHDL) ; -- cancel event #2
"RTN","SDAMEVT",68,0)
D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
"RTN","SDAMEVT",69,0)
I "^5^7^9^10^"[("^"_+SDATA("AFTER","STATUS")_"^"),$P($G(^DPT(DFN,"S",SDT,0)),"^",20) D EN^SDCODEL(+$P(^(0),"^",20),0,SDHDL),OENUL^SDAMEVT1("AFTER",SDHDL)
"RTN","SDAMEVT",70,0)
S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","SDAMEVT",71,0)
D EVT(.SDATA,2,0,SDHDL)
"RTN","SDAMEVT",72,0)
Q
"RTN","SDAMEVT",73,0)
;
"RTN","SDAMEVT",74,0)
;
"RTN","SDAMEVT",75,0)
NOSHOW(SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDHDL) ; -- no-show event #3
"RTN","SDAMEVT",76,0)
D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
"RTN","SDAMEVT",77,0)
I "^4^6^"[("^"_+SDATA("AFTER","STATUS")_"^"),$P($G(^DPT(DFN,"S",SDT,0)),"^",20) D EN^SDCODEL(+$P(^(0),"^",20),0,SDHDL),OENUL^SDAMEVT1("AFTER",SDHDL)
"RTN","SDAMEVT",78,0)
S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
"RTN","SDAMEVT",79,0)
D EVT(.SDATA,3,0,SDHDL)
"RTN","SDAMEVT",80,0)
Q
"RTN","SDAMEVT",81,0)
;
"RTN","SDAMEVT",82,0)
OE(SDCAP,SDORG,SDOE,SDHDL) ; -- set up encounter data
"RTN","SDAMEVT",83,0)
N I,OP,FILE,X,SDKID
"RTN","SDAMEVT",84,0)
;
"RTN","SDAMEVT",85,0)
; -- set up 'OP'posite variable
"RTN","SDAMEVT",86,0)
S OP=$S(SDCAP="BEFORE":"AFTER",1:"BEFORE")
"RTN","SDAMEVT",87,0)
;
"RTN","SDAMEVT",88,0)
; -- set zero of oe
"RTN","SDAMEVT",89,0)
S X=$G(^SCE(SDOE,0))
"RTN","SDAMEVT",90,0)
S ^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,0,SDCAP)=X
"RTN","SDAMEVT",91,0)
S:'$D(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,0,OP)) ^(OP)=""
"RTN","SDAMEVT",92,0)
;
"RTN","SDAMEVT",93,0)
; -- save other data
"RTN","SDAMEVT",94,0)
S FILE=409.42
"RTN","SDAMEVT",95,0)
S I=0 F S I=$O(^SDD(FILE,"OE",SDOE,I)) Q:'I D
"RTN","SDAMEVT",96,0)
. S X=$G(^SDD(FILE,I,0))
"RTN","SDAMEVT",97,0)
. S ^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I,0,SDCAP)=X
"RTN","SDAMEVT",98,0)
. S:'$D(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I,0,OP)) ^(OP)=""
"RTN","SDAMEVT",99,0)
;
"RTN","SDAMEVT",100,0)
IF SDORG'=1,SDORG'=3 G OEQ
"RTN","SDAMEVT",101,0)
;
"RTN","SDAMEVT",102,0)
; -- gets children oe's
"RTN","SDAMEVT",103,0)
S SDKID=0
"RTN","SDAMEVT",104,0)
F S SDKID=$O(^SCE("APAR",SDOE,SDKID)) Q:'SDKID D
"RTN","SDAMEVT",105,0)
. S X=$G(^SCE(SDKID,0))
"RTN","SDAMEVT",106,0)
. IF $P(X,U,8)'=4 Q ; -- must be a credit stop encounter
"RTN","SDAMEVT",107,0)
. S ^TMP("SDEVT",$J,SDHDL,4,"SDOE",SDKID,0,SDCAP)=X
"RTN","SDAMEVT",108,0)
. S:'$D(^TMP("SDEVT",$J,SDHDL,4,"SDOE",SDKID,0,OP)) ^(OP)=""
"RTN","SDAMEVT",109,0)
OEQ Q
"RTN","SDAMEVT",110,0)
;
"RTN","SDAMEVT",111,0)
OECHG(SDORG,SDHDL) ; -- compare befores and afters
"RTN","SDAMEVT",112,0)
N Y,I,SDOE S (Y,SDOE)=0
"RTN","SDAMEVT",113,0)
F S SDOE=$O(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE)) Q:'SDOE D Q:Y
"RTN","SDAMEVT",114,0)
. S I=0
"RTN","SDAMEVT",115,0)
. F S I=$O(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I)) Q:'I I $G(^(I,0,"BEFORE"))='$G(^("AFTER")) S Y=1 Q
"RTN","SDAMEVT",116,0)
Q Y
"RTN","SDAMEVT",117,0)
;
"RTN","SDAMEVT",118,0)
OEVT(SDOE,SDCAP,SDHDL,SDATA,SDOE0) ; -- event driver calls by oe
"RTN","SDAMEVT",119,0)
; SDATA only required for appts
"RTN","SDAMEVT",120,0)
; SDOE0 only required for check out deletion AFTER
"RTN","SDAMEVT",121,0)
;
"RTN","SDAMEVT",122,0)
N SD0,SDORG,SDT,DFN,SDDA,SDCL,SDOEP
"RTN","SDAMEVT",123,0)
S SD0=$S($D(^SCE(SDOE,0)):^(0),1:$G(SDOE0)),SDOEP=$P(SD0,U,6)
"RTN","SDAMEVT",124,0)
I SD0']""!(SDOEP) G OEVTQ
"RTN","SDAMEVT",125,0)
S SDT=+SD0,DFN=+$P(SD0,U,2),SDCL=+$P(SD0,U,4),SDORG=+$P(SD0,U,8),SDDA=$P(SD0,U,9)
"RTN","SDAMEVT",126,0)
I SDCAP="BEFORE" D
"RTN","SDAMEVT",127,0)
.I SDORG=1 D BEFORE(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL) Q
"RTN","SDAMEVT",128,0)
.I SDORG=2 D BEFORE^SDAMEVT2(SDOE,SDHDL) Q
"RTN","SDAMEVT",129,0)
.I SDORG=3 D BEFORE^SDAMEVT3(DFN,SDT,9,SDHDL)
"RTN","SDAMEVT",130,0)
I SDCAP="AFTER" D
"RTN","SDAMEVT",131,0)
.I SDORG=1 S SDATA=SDDA_"^"_DFN_"^"_SDT_"^"_SDCL D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL),EVT(.SDATA,5,0,SDHDL) Q
"RTN","SDAMEVT",132,0)
.I SDORG=2 D EVT^SDAMEVT2(SDOE,7,SDHDL) Q
"RTN","SDAMEVT",133,0)
.I SDORG=3 D EVT^SDAMEVT3(DFN,SDT,9,SDHDL)
"RTN","SDAMEVT",134,0)
OEVTQ Q
"RTN","SDAMEVT",135,0)
;
"RTN","SDAMEVT",136,0)
; -- SEE SDAMEVT0 FOR DOC ON VARIABLES
"VER")
8.0^22.0
**END**
**END**