source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOE2.m@ 1365

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

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1PSGOE2 ;BIR/MV-CHECK INACTIVE DRUG ; 23 Sep 98 / 8:38 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**7,19,62**;16 DEC 97
3 ;
4 ; Reference to ^PS(50.7 is supported by DBIA# 2180
5 ; Reference to ^PSDRUG( is supported by DBIA# 2192
6 ;
7CHKDRG ;*** Check inactive Orderable Item/disp drug and also if marked for UD
8 N DRG,DRGPT,INACTDT,X K PSGPFLG,PSGDFLG,PSGDI
9 ;S:'$G(PSGDI) PSGDI=$G(PSGPD)
10 S PSGDFLG='$$DDOK("^PS(55,"_PSGP_",5,"_+PSGORD_",1,",PSGPD)
11 ;S X=$P($G(^PS(50.7,PSGDI,0)),"^",4) I X,(X'>DT) S (PSGR,PSGE)="",PSGPFLG=1 Q
12 I '$$OIOK(PSGPD) S (PSGR,PSGE)="",PSGPFLG=1 Q
13 Q
14CHKDD(F) ;*** Check inactive dispense drug within the order.
15 ;* 9/20/94
16 ;* When check for a valid dispense drug, the following logic is used:
17 ;* If ^PS(55 does not have a valid ddrug, PSGDFLG=1
18 ;* If ddrug in ^PS(55, has an inactive date, don't check ^PSDRUG
19 ;* If a ddrug in ^PS(55 pointed to an invalid ^PSDRUG note, PSGDFLG=1.
20 ;* The existing ddrugs in ^PS(55 will not copy to the new order.
21 ;* Only store the new selected ddrug in the new order.
22 ;* All active ddrugs in ^PS(55 has to be checked for valid ^PSDRUG
23 ;* If ddrugs in ^PS(55 are all inactive, PSGINDT=0
24 ;* If this routine returns 1, it means either no valid ddrug in the
25 ;* drug file or all the ddrug in ^PS(55 are inactive
26 ;*
27 N DRG,DRGPT,PSGDFLG,PSGINDT
28 S PSGDFLG=0,PSGINDT=1 I '$O(@(F_"1,"_0_")")) Q 1
29 F DRG=0:0 S DRG=$O(@(F_"1,"_DRG_")")) Q:'DRG S DRGPT=^(DRG,0),INACTDT=+$P(DRGPT,U,3) I $S('INACTDT:1,1:INACTDT>DT) S PSGINDT=0 D Q:PSGDFLG
30 . I $P(^PSDRUG(+DRGPT,2),U,3)'["U"!($S('+$G(^PSDRUG(+DRGPT,"I")):0,^("I")'>DT:1,1:0)) S PSGDFLG=1
31 Q $S(PSGDFLG:1,1:PSGINDT)
32STUFFDD() ;*** Stuff DD in ^PS(53.1 only if a valid DD is 1 to 1 link to OI.
33 ;*** Stuff DD in if only one valid DD is marked for UD.
34 ;*** Do not stuff if there are multiple DD tie to a Orderable Item.
35 ;*** Do not stuff if mult. DD marked as UD item & only 1 is a valid DD
36 I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
37 N Q,X,DRG,QPT S (X,Q,QPT)=0
38 I '$O(^PS(53.1,+PSGORD,1,0)) F DRG=0:0 S DRG=$O(^PSDRUG("ASP",+$G(^PS(53.1,+PSGORD,.2)),DRG)) Q:'DRG S:$G(^PSDRUG(DRG,"I")) X=^("I")'>PSGDT I $P(^PSDRUG(DRG,2),U,3)["U" S Q=Q+1 S:'X QPT=DRG
39 Q $S(Q=1:QPT,1:0)
40CHK ; check for valid reply and questions
41 S C=1 I PSGOEA="P"!(PSGOEA="S") W $S(PSGOEA="P":"RINT",1:"HOW") Q
42 I PSGOEA="C",PSJPCAF,'PSGOENG,'$D(PSGODF),'PSGDI,'PSGPI,'$G(PSGPFLG) W "OPY" Q
43 I PSGOEA="DC",PSGACT["D" W " (DISCONTINUE)" S PSGOEA="D" Q
44 I $L(PSGOEA)=1,PSGOEA'["?",PSGACT[PSGOEA W $S(PSGOEA="R"&PSGRRF:"EINSTATE",1:$P("^YPASS^ISCONTINUE^DIT^INISH^OLD^NCOMPLETE^OG DISPLAY^ENEW^ERIFY","^",$F("BDEFHILRV",PSGOEA))) Q
45 S C=0 I PSGOEA'?1."?" W $C(7)," ??" Q
46 ;
47DDOK(PSJF,OI) ;Check to be sure all dispense drugs that are active in the
48 ;order are valid.
49 ; Input: PSJF - File root of the order including all but the IEN of
50 ; the drug. (EX "^PS(53.45,X,2,")
51 ; OI - IEN of the order's orderable item
52 ; Output: 1 - all active DD's in the order are valid
53 ; 0 - no DD's active DD's or at least one active is invalid
54 N DDCNT,ND,PSJ,X S (X,DDCNT)=0
55 I $P(PSJSYSU,";")'=3,('$O(@(PSJF_"0)"))) Q 1
56 F PSJ=0:0 S PSJ=$O(@(PSJF_PSJ_")")) Q:'PSJ!X S ND=$G(@(PSJF_PSJ_",0)")) D
57 .I $P(ND,U,3),($P(ND,U,3)'>PSGDT) Q
58 .S DDCNT=DDCNT+1
59 .S X=$S('$D(^PSDRUG(+ND,0)):1,$P($G(^(2)),U,3)'["U":1,+$G(^(2))'=+OI:1,$G(^("I"))="":0,1:^("I")'>PSGDT)
60 Q $S('DDCNT:0,X=1:0,1:1)
61 ;
62OIOK(X) ; Check to be sure orderable item is valid
63 ; input: X - IEN of orderable item
64 ; Output: 0 - invalid
65 ; 1 - valid
66 Q:'$D(^PS(50.7,X,0)) 0
67 S X=$P($G(^PS(50.7,X,0)),U,4)
68 Q $S('X:1,X'>DT:0,1:1)
Note: See TracBrowser for help on using the repository browser.