source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVSPDC.m@ 701

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1PSIVSPDC ;BIR/PR,MV-SPEED DC IV ORDERS ;02 Mar 99 / 9:27 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**23,29,38,58,110**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA# 2191.
5 ; Reference to ^PSSLOCK is supported by DBIA #2789
6 ;
7EN ;Loop thru to find IV ien to DC
8 I $S(+PSJSYSU=3:0,+PSJSYSU=1:0,1:1) D Q
9 . W !,"You're not allowed to DC orders." D PAUSE^VALM1
10 NEW ON,ON55,PSIVX,SORT,NAT,PSIVAL,PSJORD,PSGODDD,DIR
11 S PSGLMT=$O(^TMP("PSIV",$J,"XB",0))-1
12 S:PSGLMT<1 PSGLMT=$G(^TMP("PSJPRO",$J,0))
13 Q:'+PSGLMT
14 S DIR("?")="Enter the order number(s) to be Discontinued"
15 S DIR(0)="L^1:"_PSGLMT,DIR("A")="DISCONTINUE which orders" D ^DIR
16 S PSGODDD=Y Q:$D(DIRUT)
17 ;prompt for nature of order and requesting provider
18 D NATURE^PSIVOREN I '$D(P("NAT"))!'$$REQPROV^PSGOEC W !,$C(7),"No order(s) was DC." H 2 Q
19 S NAT=P("NAT") D COMMENT
20 N COMFLG,PSJCOM S PSJCOM=0
21 S SORT="" F S SORT=$O(^TMP("PSIV",$J,SORT)) Q:SORT="" F PSIVX=0:0 S PSIVX=$O(^TMP("PSIV",$J,SORT,PSIVX)) Q:'PSIVX I PSGODDD[PSIVX S ON=^(PSIVX),ON=(9999999999-ON)_$E(ON,11,11) D
22 . D CHKCOM I COMFLG D PRNT Q
23 . D:'PSJCOM SPDCIV
24 Q
25SPDCIV ;Speed DC orders
26 S (PSJORD,ON55)=ON
27 I ON["V",$P($G(^PS(55,DFN,"IV",+ON55,.2)),U,4)="D" W !," ***** DONE ORDER *****" D PRNT Q
28 I '$$LS^PSSLOCK(DFN,ON) D PRNT Q
29 I ON["V" D Q
30 . S P(3)=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,3)
31 . D NOW^%DTC Q:P(3)<%
32 . D D1^PSIVOPT2
33 . S PSIVALT=1,PSIVALCK="STOP",PSIVREA="D",ON=ON55 D LOG
34 . S:'$D(P("NAT")) P("NAT")=$G(PSJNOO) D HL^PSIVORA
35 . D UNL^PSSLOCK(DFN,ON)
36 .;;I $D(PSJNOO) S P("NAT")=PSJNOO D EN1^PSJHL2(DFN,"OC",PSJORD,"ORDER CANCELED")
37 N DA,DR,DIE,PSJND S DA=+PSJORD,PSJND=$G(^PS(53.1,DA,0)),P("OLDON")=$P(PSJND,U,25),DIE="^PS(53.1,",DR="28///"_$S($P(PSJND,U,27)="E":"DE",1:"D") D ^DIE
38 D HL^PSIVORA
39 D UNL^PSSLOCK(DFN,ON)
40 Q
41COMMENT ;Ask for activity log comments.
42 I $G(PSIVALT)=1,'$G(PSJUNDC) K DA,DIR S DIR(0)="55.04,.04" D ^DIR K DA,DIR S PSIVAL=$S($D(DIRUT):"",1:Y)
43 Q
44LOG ;Record activity log comments.
45 S:$G(PSIVALT)=2 PSIVAL="Action taken using OE/RR options." D ENTACT^PSIVAL
46 K DA,DIE,DR S DA(2)=DFN,DA(1)=+ON55,DA=PSIVLN,DIE="^PS(55,"_DFN_",""IV"","_+ON55_",""A"",",DR=".02////"_PSIVREA_";.03////"_$P(^VA(200,DUZ,0),U)_";.04////^S X=$G(PSIVAL)"_";.06////"_DUZ D ^DIE
47 D STOP^PSIVORAL ;* Record the stop dates
48 Q
49PRNT ; DISPLAY IV ORDER AND PRINT MESSAGE
50 N PSJLINE,PSJOC S PSJLINE=1
51 D DSPLORDV^PSJLMUT1(DFN,ON)
52 F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X D
53 .W !,$G(PSJOC(ON,X))
54 W !," ***** NO ACTION TAKEN ON ORDER *****",!
55 Q
56CHKCOM ;Check to see if order is part of complex order series.
57 N PSJSTAT
58 S PSJCOM=$P($G(^PS(55,PSGP,"IV",+ON,.2)),U,8),COMFLG=0,PSJSTAT=$P($G(^(0)),"^",17)
59 Q:'PSJCOM I "DE"[PSJSTAT Q
60 N PSJLINE,PSJOC S PSJLINE=1
61 D DSPLORDV^PSJLMUT1(DFN,ON)
62 W ! F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X D
63 .W !,$G(PSJOC(ON,X))
64 W !,"is part of a complex order. If you discontinue this order the following orders",!,"will be discontinued too (unless the stop date has already been reached)." D CMPLX^PSJCOM1(DFN,PSJCOM,ON)
65 F W !!,"Do you want to discontinue this series of complex orders" S %=1 D YN^DICN Q:%
66 I %'=1 S COMFLG=1 Q
67 N O,OO S O=0,OO="" F S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O F S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO="" D Q:COMFLG
68 .Q:OO=ON I '$$LS^PSSLOCK(DFN,OO) S COMFLG=1 Q
69 Q:COMFLG
70 N O,OO S O=0,OO="" F S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O F S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO="" D
71 .I (OO["U") N PSGORD S PSGORD=OO D AC^PSGOECS
72 .I (OO["V") N PSGORD S (ON,PSGORD)=OO D SPDCIV^PSIVSPDC
73 .D UNL^PSSLOCK(DFN,PSGORD)
Note: See TracBrowser for help on using the repository browser.