source: FOIAVistA/tag/r/SURGERY-SR/SROERR.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1SROERR ;B'HAM ISC/MAM,ADM - ORDER ENTRY ROUTINE ;01/22/99 9:47 AM
2 ;;3.0; Surgery ;**14,67,73,41,80,86,107,147,144**;24 Jun 93
3 ;
4 ; Reference to ^ORD(100.99 supported by DBIA #874
5 ; Reference to FILE^ORX supported by DBIA #866
6 ; Reference to ST^ORX supported by DBIA #866
7 ; Reference to NEW^VPRSR supported by DBIA #4750
8 ; Reference to DEL^VPRSR supported by DBIA #4750
9 ;
10CREATE ; create order in ORDER file (100)
11 I $P($G(^SRO(133,SRSITE,0)),"^",22)="Y" D
12 .N SROP,SROPER,SRTYPE,DYNOTE
13 .S SROP=SRTN,SROPER="" D ^SROP1 S SRTYPE=1
14 .I SROPER["REQUESTED" Q
15 .I $P($G(^SRF(SRTN,"OP")),"^",2)']"" D
16 ..W !!," This Surgery case does not have a Planned Principal CPT Code entered. The ",!," information sent to SPD for creation of a case cart may not contain ",!," enough information for processing."
17 .I SROPER["SCHEDULED" S SRTYPE=1
18 .I SROPER["NOT COMPLETE",$P($G(^SRF(SRTN,.2)),"^",10) S SRTYPE=1
19 .D ST^SRSCOR(SRTN)
20 D SERR^SROPFSS(SRTN,"SROERR")
21 N SREVENT S SREVENT="S12",SROERR=SRTN D STATUS^SROERR0,MSG^SRHLZIU(SRTN,SRSTATUS,SREVENT)
22 I $L($T(NEW^VPRSR)) D NEW^VPRSR(SROERR,$G(DFN),SRSTATUS) Q ;CPRS-R
23 I +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 K SROERR Q
24 I '$D(^ORD(100.99)) Q
25 I '$D(ORPCL) K DIC S DIC="^DIC(19,",X="SR SURGERY REQUEST",DIC(0)="" D ^DIC I Y'=-1 S ORPCL=+Y_";DIC(19,"
26REQ S ORNP=SRSDOC,ORPK=SRTN,ORSTRT=SRSDATE S:'$D(ORVP) ORVP=DFN_";DPT(" D:'$D(ORL) LOC
27 S:'$D(SROERR) SROERR=SRTN D STATUS^SROERR0 S ORTX=SRSOP_"|>> Case #"_SRTN_" "_SRSTATUS
28 I DT<$E(ORSTRT,1,7) S X1=ORSTRT,X2=DT D ^%DTC S ORPURG=X+30
29 D FILE^ORX K DIE,DA,DR S DA=SRTN,DIE=130,DR="100////"_ORIFN D ^DIE K DA,DR,DIE,ORIFN,SROERR
30 Q
31LOC S SRL=$P($G(^DPT(DFN,.1)),"^") I SRL'="" K DIC S DIC="^DIC(42,",X=SRL D ^DIC K DIC S SRL=$S(Y'=-1:+Y,1:"") S:SRL SRL=$P($G(^DIC(42,SRL,44)),"^")
32 S ORL=$S(SRL:SRL_";SC(",1:"")
33 Q
34EN ; entry for OE/RR, process order actions
35 S:'$D(ORGY) ORGY="" Q:'$D(ORACTION)!(ORGY=9) I ORGY=10 S SROERR=ORPK D ^SROERR0 Q
36 I ORACTION=7 D PURGE Q
378 I ORACTION=8 D DETAIL S:'$O(ORSLST(ORNXT)) OREND=1 Q
38 I "2345"[ORACTION W !!,"Not allowed on Surgical Requests !" Q
39 I ORACTION,ORSTS'=5 W !!,"Cannot update/delete case not in 'REQUESTED' status !" Q
40 I '$D(^XUSEC("SROREQ",DUZ)) W !!,"You must hold the 'SROREQ' key to perform this function !" G PRESS
41 D:'$D(SRSITE) ^SROVAR S DFN=+ORVP D DEM^VADPT I ORACTION=0 S ORPCL=XQORNOD D ADD Q
42 I ORACTION=1 D DISPLAY,EDIT Q
43 I ORACTION=6 D DISPLAY D DEL^SRSUPRQ G END
44 Q
45EDIT ; edit requested case
46 W !!,"1. Delete",!,"2. Update Request Information",!,"3. Change the Request Date",!!,"Select Number: " R Z:DTIME S:'$T Z="" G:"^"[Z END S:Z["?" Z=4
47 I Z<1!(Z>3)!(+Z\1'=Z) W !!,"If you want to delete this request, enter '1'. Enter '2' if you only want",!,"to update the general information about this case, or '3' to change the date",!,"for which this case is requested." G EDIT
48 I Z=1 D DEL^SRSUPRQ G END
49 I Z=2 D UPDATE^SRSUPRQ G END
50 I Z=3 D CHANGE^SRSDT
51END K SRTN D ^SRSKILL
52 Q
53DISPLAY S SRDFN=+ORVP,SRNM=VADM(1),SRTN=ORPK,SRSDATE=$P(^SRF(SRTN,0),"^",9)
54 W @IOF,!,SRNM," (",VA("PID"),")" I $P($G(^DPT(DFN,.35)),"^")'="" S Y=$P(^(.35),"^") D D^DIQ W " ** DIED: "_Y_" **" G END
55 S SRSDT=$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3) S SROPER=$P(^SRF(SRTN,"OP"),"^")_" (#"_SRTN_")"
56 K SROPS,MM,MMM S:$L(SROPER)<71 SROPS(1)=SROPER I $L(SROPER)>70 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
57 W !!,SRSDT,?11,SROPS(1) I $D(SROPS(2)) W !,?11,SROPS(2) I $D(SROPS(3)) W !,?11,SROPS(3)
58 Q
59LOOP ; break case information if longer than 70 characters
60 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<70 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
61 Q
62PRESS W !!,"Press RETURN to continue " R X:DTIME G:'$T END
63 Q
64DETAIL I $E(IOST)="C" W !!,"Press RETURN to review case information, or '^' to quit. " R X:DTIME I '$T!(X["^") S OREND=1 Q
65 S SRTN=ORPK I $P($G(^SRF(SRTN,"NON")),"^")="Y" D ^SROERR2 G END
66 D ^SROERR1,END
67 Q
68ADD ; add new requests to ORDER file (100)
69 W @IOF,!,VADM(1)," (",VA("PID"),")" I $P($G(^DPT(+ORVP,.35)),"^")'="" S Y=$P(^(.35),"^") D D^DIQ W " ** DIED: "_Y_" **"
70 W !!,"Add New Surgery Requests",!!!,"1. Make Operation Requests",!,"2. Make a Request from the Waiting List",!,"3. Make a Request for Concurrent Cases"
71 W !!,"Select Number: " R Z:DTIME S:'$T Z="" G:"^"[Z END S:Z["?" Z=4
72 I Z<1!(Z>3)!(+Z\1'=Z) W !!,"If you want to make a new operation request, enter '1'. Enter '2' if you want",!,"to make a request from the surgery waiting list, or '3' to make a request for",!,"concurrent cases." D PRESS G ADD
73 I Z=1 D ^SRSMREQ G END
74 I Z=2 D ^SRSWREQ G END
75 I Z=3 D ^SRSCONR G END
76 Q
77PURGE ; purge order from ORDER file
78 N SREVENT,SRSTATUS S SREVENT="S17",SRSTATUS="(DELETED)" D MSG^SRHLZIU(ORPK,SRSTATUS,SREVENT)
79 I $L($T(DEL^VPRSR)) D DEL^VPRSR(ORPK,$G(DFN)) Q ;CPRS-R
80 I +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 Q
81 I "589"'[ORSTS S:$D(^SRF(ORPK,0)) $P(^(0),"^",14)="" S ORSTS="K" D ST^ORX
82 Q
83DEL ; delete from ORDER file (100) and call CoreFLS API
84 I $P($G(^SRO(133,SRSITE,0)),"^",22)="Y" D
85 .N SRDYNOTE,SRTYPE
86 .S SRDYNOTE=$P($G(^SRF(SRTN,31)),"^",10) Q:'SRDYNOTE
87 .I SRDYNOTE S SRTYPE=4 D ST^SRSCOR(SRTN)
88 N SREVENT,SRSTATUS S SREVENT="S17",SRSTATUS="(DELETED)" D MSG^SRHLZIU(SRTN,SRSTATUS,SREVENT)
89 I $L($T(DEL^VPRSR)) D DEL^VPRSR(SRTN,$G(DFN)) Q ;CPRS-R
90 I +$$VERSION^XPDUTL("ORDER ENTRY/RESULTS REPORTING")>2.5 Q
91 S:'$D(ORIFN) ORIFN=$P(^SRF(SRTN,0),"^",14) I $D(ORIFN) S ORSTS="K" D ST^ORX K ORIFN
92 Q
Note: See TracBrowser for help on using the repository browser.