Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSGOE2

PSGOE2.m

Go to the documentation of this file.
  1. PSGOE2 ;BIR/MV-CHECK INACTIVE DRUG ; 23 Sep 98 / 8:38 AM
  1. ;;5.0; INPATIENT MEDICATIONS ;**7,19,62**;16 DEC 97
  1. ;
  1. ; Reference to ^PS(50.7 is supported by DBIA# 2180
  1. ; Reference to ^PSDRUG( is supported by DBIA# 2192
  1. ;
  1. CHKDRG ;*** Check inactive Orderable Item/disp drug and also if marked for UD
  1. N DRG,DRGPT,INACTDT,X K PSGPFLG,PSGDFLG,PSGDI
  1. ;S:'$G(PSGDI) PSGDI=$G(PSGPD)
  1. S PSGDFLG='$$DDOK("^PS(55,"_PSGP_",5,"_+PSGORD_",1,",PSGPD)
  1. ;S X=$P($G(^PS(50.7,PSGDI,0)),"^",4) I X,(X'>DT) S (PSGR,PSGE)="",PSGPFLG=1 Q
  1. I '$$OIOK(PSGPD) S (PSGR,PSGE)="",PSGPFLG=1 Q
  1. Q
  1. CHKDD(F) ;*** Check inactive dispense drug within the order.
  1. ;* 9/20/94
  1. ;* When check for a valid dispense drug, the following logic is used:
  1. ;* If ^PS(55 does not have a valid ddrug, PSGDFLG=1
  1. ;* If ddrug in ^PS(55, has an inactive date, don't check ^PSDRUG
  1. ;* If a ddrug in ^PS(55 pointed to an invalid ^PSDRUG note, PSGDFLG=1.
  1. ;* The existing ddrugs in ^PS(55 will not copy to the new order.
  1. ;* Only store the new selected ddrug in the new order.
  1. ;* All active ddrugs in ^PS(55 has to be checked for valid ^PSDRUG
  1. ;* If ddrugs in ^PS(55 are all inactive, PSGINDT=0
  1. ;* If this routine returns 1, it means either no valid ddrug in the
  1. ;* drug file or all the ddrug in ^PS(55 are inactive
  1. ;*
  1. N DRG,DRGPT,PSGDFLG,PSGINDT
  1. S PSGDFLG=0,PSGINDT=1 I '$O(@(F_"1,"_0_")")) Q 1
  1. 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
  1. . I $P(^PSDRUG(+DRGPT,2),U,3)'["U"!($S('+$G(^PSDRUG(+DRGPT,"I")):0,^("I")'>DT:1,1:0)) S PSGDFLG=1
  1. Q $S(PSGDFLG:1,1:PSGINDT)
  1. STUFFDD() ;*** Stuff DD in ^PS(53.1 only if a valid DD is 1 to 1 link to OI.
  1. ;*** Stuff DD in if only one valid DD is marked for UD.
  1. ;*** Do not stuff if there are multiple DD tie to a Orderable Item.
  1. ;*** Do not stuff if mult. DD marked as UD item & only 1 is a valid DD
  1. I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
  1. N Q,X,DRG,QPT S (X,Q,QPT)=0
  1. 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
  1. Q $S(Q=1:QPT,1:0)
  1. CHK ; check for valid reply and questions
  1. S C=1 I PSGOEA="P"!(PSGOEA="S") W $S(PSGOEA="P":"RINT",1:"HOW") Q
  1. I PSGOEA="C",PSJPCAF,'PSGOENG,'$D(PSGODF),'PSGDI,'PSGPI,'$G(PSGPFLG) W "OPY" Q
  1. I PSGOEA="DC",PSGACT["D" W " (DISCONTINUE)" S PSGOEA="D" Q
  1. 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
  1. S C=0 I PSGOEA'?1."?" W $C(7)," ??" Q
  1. ;
  1. DDOK(PSJF,OI) ;Check to be sure all dispense drugs that are active in the
  1. ;order are valid.
  1. ; Input: PSJF - File root of the order including all but the IEN of
  1. ; the drug. (EX "^PS(53.45,X,2,")
  1. ; OI - IEN of the order's orderable item
  1. ; Output: 1 - all active DD's in the order are valid
  1. ; 0 - no DD's active DD's or at least one active is invalid
  1. N DDCNT,ND,PSJ,X S (X,DDCNT)=0
  1. I $P(PSJSYSU,";")'=3,('$O(@(PSJF_"0)"))) Q 1
  1. F PSJ=0:0 S PSJ=$O(@(PSJF_PSJ_")")) Q:'PSJ!X S ND=$G(@(PSJF_PSJ_",0)")) D
  1. .I $P(ND,U,3),($P(ND,U,3)'>PSGDT) Q
  1. .S DDCNT=DDCNT+1
  1. .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)
  1. Q $S('DDCNT:0,X=1:0,1:1)
  1. ;
  1. OIOK(X) ; Check to be sure orderable item is valid
  1. ; input: X - IEN of orderable item
  1. ; Output: 0 - invalid
  1. ; 1 - valid
  1. Q:'$D(^PS(50.7,X,0)) 0
  1. S X=$P($G(^PS(50.7,X,0)),U,4)
  1. Q $S('X:1,X'>DT:0,1:1)