source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGMMAR5.m@ 1474

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1PSGMMAR5 ;BIR/CML3-MD MARS - GATHER INFO FOR ACK ORDERS ;14 Oct 98 / 4:29 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**15,20,111,145**;16 DEC 97;Build 17
3 ;
4PEND ;*** Only select orders that were acknowledged by nurses and
5 ;*** still having pending status.
6 ;The next 4 lines are looking only at ward parameters. If there is an inpatient with pending orders, the orders will print on the MAR.
7 NEW PSJSYSW,PSJSYSW0
8 S PSJSYSW=$O(^PS(59.6,"B",+$G(PSJPWD),0))
9 S:PSJSYSW PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
10 Q:'+$P($G(PSJSYSW0),U,6) ;Quit if the order is not pending.
11 ;
12 NEW ND,ON,TYPE,QST
13 F ON=0:0 S ON=$O(^PS(53.1,"AV",PSGP,ON)) Q:'ON D
14 . S ND=$G(^PS(53.1,ON,0)),TYPE=$P(ND,U,4)
15 . I $P(ND,U,7)="P"!($P($G(^PS(53.1,ON,2)),U)["PRN") S QST="OZ"_$S($P(ND,U,4)="F":"V",1:"A")
16 . E S QST="CZ"_$S($P(ND,U,4)="F":"V",1:"A")
17 . I PSGMTYPE[1 D:TYPE'="F" SETTMP D:TYPE="F" IV
18 . I PSGMTYPE'[1 D
19 .. I PSGMTYPE[2,(TYPE="U") D SETTMP Q
20 .. I PSGMTYPE'[2,(TYPE="I") D SETTMP Q
21 .. I PSGMTYPE[4,(TYPE="F") D IV
22 Q
23 ;
24SETTMP ;*** Setup ^tmp for pending U/D and Inpatient med IVs.
25 ;*** OZ_(V/A) = PRN/One time orders (V=IV).
26 ;*** CZ_(V/A) = Continuous orders (A=U/D).
27 I PSGMARS=2,(QST["CZ") Q
28 I PSGMARS=1,(QST["OZ") Q
29 NEW MARX
30 D DRGDISP^PSJLMUT1(PSGP,+ON_"P",20,0,.MARX,1) S DRG=MARX(1)_U_+ON_"P"
31 N PSGMARWC,A ;DEM 04/19/2006 - PSGMARWC is used to preserve original value of PSGMARWN (patient location) in case location is changed by an order with a clinic location.
32 S PSGMARWC=PSGMARWN
33 S A=$G(^PS(53.1,+ON,"DSS")) I $P(A,"^")]"" S PSGMARWN="C!"_$P(A,"^") I $G(SUB1)]"",$G(SUB2)]"",'$D(^TMP($J,TM,PSGMARWN,SUB1,SUB2)) D
34 . N X
35 . D:$G(PSGMAR24) SPN^PSGMAR0 D:'$G(PSGMAR24) SPN^PSGMMAR0
36 . Q
37 I (PSGSS="P")!(PSGSS="C")!(PSGSS="L") S ^TMP($J,PPN,PSGMARWN,$S(+PSGMSORT:$E(QST,1),1:QST),DRG)="" S:PSGMARWN'=PSGMARWC PSGMARWN=PSGMARWC Q
38 S ^TMP($J,TM,PSGMARWN,SUB1,SUB2,$S(+PSGMSORT:$E(QST,1),1:QST),DRG)=""
39 ;
40 ;DAM 5-01-07 add XTMP global for printing when PSGSS is not "P", "C", or "L". This reverses PSGMARWN (ward) and SUB1 (patient) so printing will occur with all locations (ward and clinic) appearing together under the patient's name
41 S ^XTMP(PSGREP,TM,SUB1,PSGMARWN,SUB2,$S(+PSGMSORT:$E(QST,1),1:QST),DRG)=""
42 ;
43 S:PSGMARWN'=PSGMARWC PSGMARWN=PSGMARWC Q
44 Q
45 ;
46IV ;*** Sort IV pending orders for 24 Hrs, 7/14 Day MAR.
47 K DRG,P N X,ON55,PSJLABEL S DFN=PSGP,PSJLABEL=1 D GT531^PSIVORFA(DFN,ON)
48 S X=$P(P("MR"),U,2)
49 S QST=QST_4
50 N PSGMARWC ;DEM 04/19/2006 - PSGMARWC is used to preserve original value of PSGMARWN (patient location) in case location is changed by an order with a clinic location.
51 S PSGMARWC=PSGMARWN
52 I $G(DRG) S X=$S($G(DRG("AD",1)):DRG("AD",1),1:$G(DRG("SOL",1))),X=$E($P(X,U,2),1,20)_U_+ON_"P" D
53 . N A
54 . S A=$G(^PS(53.1,+ON,"DSS")) I $P(A,"^")]"" S PSGMARWN="C!"_$P(A,"^") I $G(SUB1)]"",$G(SUB2)]"",'$D(^TMP($J,TM,PSGMARWN,SUB1,SUB2)) D
55 . . N X
56 . . D:$G(PSGMAR24) SPN^PSGMAR0 D:'$G(PSGMAR24) SPN^PSGMMAR0
57 . . Q
58 . I PSGSS="P"!(PSGSS="C")!(PSGSS="L") S ^TMP($J,PPN,PSGMARWN,$S(+PSGMSORT:$E(QST,1),1:QST),X)="" Q
59 . S:PSGRBPPN="R" ^TMP($J,TM,PSGMARWN,PSJPRB,PPN,$S(+PSGMSORT:$E(QST,1),1:QST),X)=""
60 . S:PSGRBPPN="P" ^XTMP(PSGREP,TM,PPN,PSGMARWN,PSJPRB,$S(+PSGMSORT:$E(QST,1),1:QST),X)="" ;DAM 5-01-07 set ^XTMP global when sorting by patient
61 . Q
62 S:PSGMARWN'=PSGMARWC PSGMARWN=PSGMARWC
63 Q
Note: See TracBrowser for help on using the repository browser.