source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORKPS1.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1ORKPS1 ; slc/CLA - Order checking support procedures for medications ;12/15/97 [8/2/05 7:46am]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**232**;Dec 17, 1997;Build 19
3 Q
4PROCESS(OI,DFN,ORKDG) ;process data from pharmacy order check API
5 Q:'$D(^TMP($J))
6 N II,XX,ZZ,ZZD,ORTYPE,ORMTYPE,ORN,ORZ,RCNT
7 S II=1,XX=0,ZZ="",ZZD="",RCNT=0
8 ;
9 ;check to determine if inpatient or outpatient:
10 I $L(ORKDG) S ORTYPE=$S($G(ORKDG)="PSI":"I",$G(ORKDG)="PSO":"O",$G(ORKDG)="PSIV":"I",$G(ORKDG)="PSH":"O",1:"")
11 I '$L(ORTYPE) D ;if no display group
12 .D ADM^VADPT2
13 .S ORTYPE=$S(+$G(VADMVT)>0:"I",1:"O")
14 .K VADMVT
15 ;
16 ; drug-drug interactions:
17 F S XX=$O(^TMP($J,"DI",XX)) Q:XX<1 D
18 .S ZZ=$G(^TMP($J,"DI",XX,0))
19 .S ORN=$P($P(ZZ,U,7),";"),ORZ=""
20 .I '$G(ORN),$L($G(^TMP($J,"DI",XX,1))) D Q
21 ..N ORTXT,ORLEN,ORFAC,END
22 ..S RCNT=RCNT+1
23 ..S $P(ZZ,U,7)="R"_RCNT
24 ..S ORFAC=$P(ZZ,U,9)
25 ..S ORTXT=$P(^TMP($J,"DI",XX,1),U)_" "
26 ..I $L(ORTXT)<242 S ORLEN=242-$L(ORTXT),ORTXT=ORTXT_$E(^TMP($J,"DI",XX,1,0),1,ORLEN)
27 ..S OREND="["_$P(^TMP($J,"DI",XX,1),U,2)_" - Last Fill: "_$P(^TMP($J,"DI",XX,1),U,3)_" Quantity Dispensed: "_$P(^TMP($J,"DI",XX,1),U,5)_"] >> "_ORFAC
28 ..N ORMAX S ORMAX=250-$L(OREND)-50-$L($P(ZZ,U,4))-$L($P(ZZ,U,5))-$L($P(ZZ,U,6))-$L($P(ZZ,U,7))
29 ..I ORTXT'=$E(ORTXT,1,ORMAX) S OREND="..."_OREND
30 ..S ORTXT=$E(ORTXT,1,ORMAX)_OREND
31 ..S $P(ZZ,U,2)=ORTXT
32 ..S YY(II)="DI^"_ZZ,II=II+1
33 .I $L(ORN),$D(^OR(100,ORN,8,0)) S ORZ=^OR(100,ORN,8,0)
34 .I $L($G(ORZ)),($P(^OR(100,ORN,8,$P(ORZ,U,3),0),U,2)="DC") Q
35 .I $L(ORN),$P(^ORD(100.01,$P(^OR(100,ORN,3),U,3),0),U)="DISCONTINUED" Q
36 .I ZZ'="" S YY(II)="DI^"_ZZ,II=II+1
37 ;
38 ; duplicate drugs:
39 Q:$$SOLUT^ORKPS(OI) ;quit if the orderable item is a solution
40 ;require that we do not perform dup drug/class OCs for solutions)
41 S XX=0,ZZ=""
42 F S XX=$O(^TMP($J,"DD",XX)) Q:XX<1 D
43 .S ZZ=$G(^TMP($J,"DD",XX,0)),ORMTYPE=$P($P(ZZ,U,4),";",2)
44 .I $G(ORTYPE)'=$G(ORMTYPE),'$L($G(^TMP($J,"DD",XX,1))) Q
45 .S ORN=$P($P(ZZ,U,3),";"),ORZ=""
46 .I '$G(ORN),$L($G(^TMP($J,"DD",XX,1))) D Q
47 ..Q:$$SUPPLY^ORKPS(OI) ;quit if the orderable item is a supply and it is against remote data
48 ..N ORTXT,ORLEN,ORFAC,OREND
49 ..S RCNT=RCNT+1
50 ..S $P(ZZ,U,3)="R"_RCNT
51 ..S ORFAC=$P(ZZ,U,5)
52 ..S ORTXT=$P(^TMP($J,"DD",XX,1),U)_" "
53 ..I $L(ORTXT)<242 S ORLEN=242-$L(ORTXT),ORTXT=ORTXT_$E(^TMP($J,"DD",XX,1,0),1,ORLEN)
54 ..S OREND="["_$P(^TMP($J,"DD",XX,1),U,2)_" - Last Fill: "_$P(^TMP($J,"DD",XX,1),U,3)_" Quantity Dispensed: "_$P(^TMP($J,"DD",XX,1),U,5)_"] >> "_ORFAC
55 ..N ORMAX S ORMAX=250-$L(OREND)-40-$L($P(ZZ,U,4))
56 ..I ORTXT'=$E(ORTXT,1,ORMAX) S OREND="..."_OREND
57 ..S ORTXT=$E(ORTXT,1,ORMAX)_OREND
58 ..S $P(ZZ,U,2)=ORTXT
59 ..S YY(II)="DD^"_ZZ,II=II+1
60 .Q:+$G(ORN)=+$G(ORIFN) ;QUIT if dup med ord # = current ord #
61 .I $L(ORN),$D(^OR(100,ORN,8,0)) S ORZ=^OR(100,ORN,8,0)
62 .I $L($G(ORZ)),($P(^OR(100,ORN,8,$P(ORZ,U,3),0),U,2)="DC") Q
63 .I $L(ORN),$P(^ORD(100.01,$P(^OR(100,ORN,3),U,3),0),U)="DISCONTINUED" Q
64 .I ZZ'="" S YY(II)="DD^"_ZZ,II=II+1
65 ;
66 ; duplicate classes:
67 Q:$$SUPPLY^ORKPS(OI) ;quit if the orderable item is a supply
68 S XX=0,ZZ=""
69 F S XX=$O(^TMP($J,"DC",XX)) Q:XX<1 D
70 .S ZZ=$G(^TMP($J,"DC",XX,0)),ORMTYPE=$P($P(ZZ,U,6),";",2)
71 .I $G(ORTYPE)'=$G(ORMTYPE),'$L($G(^TMP($J,"DC",XX,1))) Q
72 .S ORN=$P($P(ZZ,U,5),";"),ORZ=""
73 .I '$G(ORN),$L($G(^TMP($J,"DC",XX,1))) D Q
74 ..N ORTXT,ORLEN,ORFAC,OREND
75 ..S RCNT=RCNT+1
76 ..S $P(ZZ,U,5)="R"_RCNT
77 ..S ORFAC=$P(ZZ,U,7)
78 ..S ORTXT=$P(^TMP($J,"DC",XX,1),U)_" "
79 ..I $L(ORTXT)<242 S ORLEN=242-$L(ORTXT),ORTXT=ORTXT_$E(^TMP($J,"DC",XX,1,0),1,ORLEN)
80 ..S OREND="["_$P(^TMP($J,"DC",XX,1),U,2)_" - Last Fill: "_$P(^TMP($J,"DC",XX,1),U,3)_" Quantity Dispensed: "_$P(^TMP($J,"DC",XX,1),U,5)_"] >> "_ORFAC
81 ..N ORMAX S ORMAX=250-$L(OREND)-50-$L($P(ZZ,U,2))-$L($P(ZZ,U,5))
82 ..I ORTXT'=$E(ORTXT,1,ORMAX) S OREND="..."_OREND
83 ..S ORTXT=$E(ORTXT,1,ORMAX)_OREND
84 ..S $P(ZZ,U,4)=ORTXT
85 ..S YY(II)="DC^"_ZZ,II=II+1
86 .Q:+$G(ORN)=+$G(ORIFN) ;QUIT if dup class ord # = current ord #
87 .I $L(ORN),$D(^OR(100,ORN,8,0)) S ORZ=^OR(100,ORN,8,0)
88 .I $L($G(ORZ)),($P(^OR(100,ORN,8,$P(ORZ,U,3),0),U,2)="DC") Q
89 .I $L(ORN),$P(^ORD(100.01,$P(^OR(100,ORN,3),U,3),0),U)="DISCONTINUED" Q
90 .I ZZ'="" S YY(II)="DC^"_ZZ,II=II+1
91 Q
Note: See TracBrowser for help on using the repository browser.