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

PSSWRNA.m

Go to the documentation of this file.
  1. PSSWRNA ;BIR/EJW-API TO RETRIEVE WARNING LABEL LIST ;04/09/04
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**87**;9/30/97
  1. ;
  1. ;Reference to ^PSNDF(50.68 supported by DBIA 3735
  1. ;Reference to ^PS(50.625 supported by DBIA 4445
  1. ;Reference to ^PS(50.626 supported by DBIA 4446
  1. ;Reference to ^PS(50.627 supported by DBIA 4448
  1. DRUG(XX,DFN) ; Return warning labels numbers associated with this drug
  1. ;
  1. ; entry point from Outpatient Pharmacy and Consolidated Mail Outpatient Pharmacy
  1. ; Calling method: S WARN=$$DRUG^PSSWRNA(DRUG,DFN)
  1. ;
  1. ; Input: DRUG = IEN from the DRUG file (50) ** REQUIRED **
  1. ; Input: DFN = IEN from the PATIENT file (2) ** OPTIONAL **
  1. ;
  1. ; Output: WARN = List of warning numbers, separated by commas, associated with this drug. Warning numbers from the new data source will be followed by an "N".
  1. ;
  1. N I,PSSWSITE
  1. S PSSWRN=""
  1. S PSSWSITE=+$O(^PS(59.7,0)) I $P($G(^PS(59.7,PSSWSITE,10)),"^",9)="N" D WARNLST
  1. I PSSWRN="" S PSSWRN=$P($G(^PSDRUG(XX,0)),"^",8)
  1. D CHECKLST
  1. D CHECK20
  1. Q PSSWRN
  1. ;
  1. CHECK20 ; WARNING LABEL 20 - 'DO NOT TRANSFER' REQUIRED FOR CONTROLLED SUBSTANCES
  1. N I
  1. S DEA=$P($G(^PSDRUG(XX,0)),"^",3)
  1. I DEA="" Q
  1. I "12345"'[$E(DEA) Q
  1. I ","_$P(PSSWRN,",",1,5)_","[",20," Q
  1. I $L(PSSWRN,",")<5 S PSSWRN=$S(PSSWRN="":20,1:PSSWRN_",20") Q
  1. S PSSWRN=$P(PSSWRN,",",1,4)_",20,"_$P(PSSWRN,",",5,99)
  1. F I=6:1:$L(PSSWRN,",") I $P(PSSWRN,",",I)=20 S PSSWRN=$P(PSSWRN,",",1,I-1) I $P(PSSWRN,",",I+1,99)'="" S PSSWRN=PSSWRN_","_$P(PSSWRN,",",I+1,99)_$P(PSSWRN,",",I+1,99) Q
  1. Q
  1. ;
  1. WARNLST ; GET WARNING LIST FROM NEW DATA SOURCE OR USER-DEFINED NEW WARNING LABEL LIST
  1. S PSSWRN=$P($G(^PSDRUG(XX,"WARN")),"^") I PSSWRN'="" Q
  1. ; GET WARNINGS FROM NEW COMMERCIAL SOURCE
  1. N PSOPROD,GCNSEQNO,SEQ,NEWWARN,I
  1. S PSOPROD=$P($G(^PSDRUG(XX,"ND")),"^",3) I PSOPROD="" Q
  1. S GCNSEQNO=$$GET1^DIQ(50.68,PSOPROD,11,"I")
  1. I GCNSEQNO="" Q
  1. GCN S I="" F S I=$O(^PS(50.627,"B",GCNSEQNO,I)) Q:'I I I D
  1. .S NEWWARN=$G(^PS(50.627,I,0)) I $P(NEWWARN,"^")=GCNSEQNO S SEQ=+$P(NEWWARN,"^",3) I SEQ>0 S NEWWARN(SEQ)=+$P(NEWWARN,"^",2)
  1. S SEQ=0 F S SEQ=$O(NEWWARN(SEQ)) Q:'SEQ S PSSWRN=$S(PSSWRN'="":PSSWRN_",",1:"")_NEWWARN(SEQ)_"N"
  1. Q
  1. WARN54 ; VERIFY ENTRY EXISTS. IF NOT, REMOVE FROM WARNING LIST
  1. I '$D(^PS(54,WARN,1)) S PSSWRN=$P(PSSWRN,",",1,I-1)_$S(I=1:"",1:",")_$P(PSSWRN,",",I+1,99),I=I-1
  1. Q
  1. NEWWARN ;
  1. I '$D(^PS(50.625,WARN,1)) S PSSWRN=$P(PSSWRN,",",1,I-1)_$S(I=1:"",1:",")_$P(PSSWRN,",",I+1,99),I=I-1
  1. Q
  1. CHECKLST ;
  1. N WARN
  1. F I=1:1:$L(PSSWRN,",") S WARN=$P(PSSWRN,",",I) I WARN'="" D
  1. .I WARN'["N" D WARN54 Q
  1. .S WARN=+WARN D GENDER I WARN'="" D NEWWARN
  1. I $E(PSSWRN,$L(PSSWRN))="," S PSSWRN=$E(PSSWRN,1,($L(PSSWRN)-1))
  1. Q
  1. GENDER ;
  1. I $G(DFN)="" Q
  1. N SEX,GENDER
  1. S GENDER=$$GET1^DIQ(50.625,WARN,2,"I") I GENDER="" Q
  1. I GENDER'="F",GENDER'="M" Q
  1. S SEX=$$GET1^DIQ(2,DFN,.02,"I")
  1. I $G(SEX)="" Q
  1. I SEX'="F",SEX'="M" Q
  1. I SEX'=GENDER,$$GET1^DIQ(50,XX,8.2,"I")="N" D
  1. .S PSSWRN=$P(PSSWRN,",",1,I-1)_$S(I=1:"",1:",")_$P(PSSWRN,",",I+1,99),I=I-1
  1. Q
  1. WTEXT(WARN,LAN) ;
  1. ;
  1. ; entry point from Outpatient Pharmacy and Consolidated Mail Outpatient Pharmacy
  1. ; Calling method: S TEXT=$$WTEXT^PSSWRNA(WARN,LAN)
  1. ;
  1. ; Input: WARN = A warning label number from the old RX Consult file (#54) or the new WARNING LABEL-ENGLISH file (#50.625) followed by an "N". ** REQUIRED **
  1. ; Note: there is a one-to-one correspondence for entries in the WARNING LABEL-ENGLISH file (#50.625) and the WARNING LABEL-SPANISH file (#50.626).
  1. ;
  1. ; LAN = Patient's PMI language preference. 2=Spanish. Anything less than 2 is English ** OPTIONAL **
  1. ;
  1. ; Output: TEXT = Warning label text for the warning number. If LAN=2 the text will be returned in Spanish if a translation is available, otherwise the text will be returned in English.
  1. ;
  1. S TEXT=""
  1. I WARN'["N" D
  1. . I $G(LAN)=2 D
  1. .. I $D(^PS(54,WARN,3)) S TEXT=^(3)
  1. . I TEXT="" S JJJ=0 F S JJJ=$O(^PS(54,WARN,1,JJJ)) Q:('JJJ) D
  1. .. I $D(^PS(54,WARN,1,JJJ,0)) S TEXT=TEXT_$S(TEXT="":"",1:" ")_^(0)
  1. I WARN["N" D
  1. .I $G(LAN)'=2 D Q
  1. .. S PSOWRNN=+WARN I $D(^PS(50.625,PSOWRNN)) D
  1. ... S TEXT="",JJJ=0
  1. ... F S JJJ=$O(^PS(50.625,PSOWRNN,1,JJJ)) Q:('JJJ) D
  1. .... I $D(^PS(50.625,PSOWRNN,1,JJJ,0)) S TEXT=TEXT_$S(TEXT="":"",1:" ")_^(0)
  1. . S PSOWRNN=+WARN I $D(^PS(50.626,PSOWRNN)) D
  1. .. S TEXT="",JJJ=0
  1. .. F S JJJ=$O(^PS(50.626,PSOWRNN,1,JJJ)) Q:('JJJ) D
  1. ... I $D(^PS(50.626,PSOWRNN,1,JJJ,0)) S TEXT=TEXT_$S(TEXT="":"",1:" ")_^(0)
  1. Q TEXT
  1. ;
  1. GENDER2 ;
  1. N I,WARN
  1. S GENDER=""
  1. I $G(PSSWRN)'["N" Q
  1. F I=1:1 S WARN=$P(PSSWRN,",",I) Q:WARN="" D Q:GENDER'=""
  1. .I WARN'["N" Q
  1. .S WARN=+WARN,GENDER=$$GET1^DIQ(50.625,WARN,2,"I")
  1. Q
  1. ;