PSSWRNA ;BIR/EJW-API TO RETRIEVE WARNING LABEL LIST ;04/09/04
;;1.0;PHARMACY DATA MANAGEMENT;**87**;9/30/97
;
;Reference to ^PSNDF(50.68 supported by DBIA 3735
;Reference to ^PS(50.625 supported by DBIA 4445
;Reference to ^PS(50.626 supported by DBIA 4446
;Reference to ^PS(50.627 supported by DBIA 4448
DRUG(XX,DFN) ; Return warning labels numbers associated with this drug
;
; entry point from Outpatient Pharmacy and Consolidated Mail Outpatient Pharmacy
; Calling method: S WARN=$$DRUG^PSSWRNA(DRUG,DFN)
;
; Input: DRUG = IEN from the DRUG file (50) ** REQUIRED **
; Input: DFN = IEN from the PATIENT file (2) ** OPTIONAL **
;
; 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".
;
N I,PSSWSITE
S PSSWRN=""
S PSSWSITE=+$O(^PS(59.7,0)) I $P($G(^PS(59.7,PSSWSITE,10)),"^",9)="N" D WARNLST
I PSSWRN="" S PSSWRN=$P($G(^PSDRUG(XX,0)),"^",8)
D CHECKLST
D CHECK20
Q PSSWRN
;
CHECK20 ; WARNING LABEL 20 - 'DO NOT TRANSFER' REQUIRED FOR CONTROLLED SUBSTANCES
N I
S DEA=$P($G(^PSDRUG(XX,0)),"^",3)
I DEA="" Q
I "12345"'[$E(DEA) Q
I ","_$P(PSSWRN,",",1,5)_","[",20," Q
I $L(PSSWRN,",")<5 S PSSWRN=$S(PSSWRN="":20,1:PSSWRN_",20") Q
S PSSWRN=$P(PSSWRN,",",1,4)_",20,"_$P(PSSWRN,",",5,99)
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
Q
;
WARNLST ; GET WARNING LIST FROM NEW DATA SOURCE OR USER-DEFINED NEW WARNING LABEL LIST
S PSSWRN=$P($G(^PSDRUG(XX,"WARN")),"^") I PSSWRN'="" Q
; GET WARNINGS FROM NEW COMMERCIAL SOURCE
N PSOPROD,GCNSEQNO,SEQ,NEWWARN,I
S PSOPROD=$P($G(^PSDRUG(XX,"ND")),"^",3) I PSOPROD="" Q
S GCNSEQNO=$$GET1^DIQ(50.68,PSOPROD,11,"I")
I GCNSEQNO="" Q
GCN S I="" F S I=$O(^PS(50.627,"B",GCNSEQNO,I)) Q:'I I I D
.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)
S SEQ=0 F S SEQ=$O(NEWWARN(SEQ)) Q:'SEQ S PSSWRN=$S(PSSWRN'="":PSSWRN_",",1:"")_NEWWARN(SEQ)_"N"
Q
WARN54 ; VERIFY ENTRY EXISTS. IF NOT, REMOVE FROM WARNING LIST
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
Q
NEWWARN ;
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
Q
CHECKLST ;
N WARN
F I=1:1:$L(PSSWRN,",") S WARN=$P(PSSWRN,",",I) I WARN'="" D
.I WARN'["N" D WARN54 Q
.S WARN=+WARN D GENDER I WARN'="" D NEWWARN
I $E(PSSWRN,$L(PSSWRN))="," S PSSWRN=$E(PSSWRN,1,($L(PSSWRN)-1))
Q
GENDER ;
I $G(DFN)="" Q
N SEX,GENDER
S GENDER=$$GET1^DIQ(50.625,WARN,2,"I") I GENDER="" Q
I GENDER'="F",GENDER'="M" Q
S SEX=$$GET1^DIQ(2,DFN,.02,"I")
I $G(SEX)="" Q
I SEX'="F",SEX'="M" Q
I SEX'=GENDER,$$GET1^DIQ(50,XX,8.2,"I")="N" D
.S PSSWRN=$P(PSSWRN,",",1,I-1)_$S(I=1:"",1:",")_$P(PSSWRN,",",I+1,99),I=I-1
Q
WTEXT(WARN,LAN) ;
;
; entry point from Outpatient Pharmacy and Consolidated Mail Outpatient Pharmacy
; Calling method: S TEXT=$$WTEXT^PSSWRNA(WARN,LAN)
;
; 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 **
; 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).
;
; LAN = Patient's PMI language preference. 2=Spanish. Anything less than 2 is English ** OPTIONAL **
;
; 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.
;
S TEXT=""
I WARN'["N" D
. I $G(LAN)=2 D
.. I $D(^PS(54,WARN,3)) S TEXT=^(3)
. I TEXT="" S JJJ=0 F S JJJ=$O(^PS(54,WARN,1,JJJ)) Q:('JJJ) D
.. I $D(^PS(54,WARN,1,JJJ,0)) S TEXT=TEXT_$S(TEXT="":"",1:" ")_^(0)
I WARN["N" D
.I $G(LAN)'=2 D Q
.. S PSOWRNN=+WARN I $D(^PS(50.625,PSOWRNN)) D
... S TEXT="",JJJ=0
... F S JJJ=$O(^PS(50.625,PSOWRNN,1,JJJ)) Q:('JJJ) D
.... I $D(^PS(50.625,PSOWRNN,1,JJJ,0)) S TEXT=TEXT_$S(TEXT="":"",1:" ")_^(0)
. S PSOWRNN=+WARN I $D(^PS(50.626,PSOWRNN)) D
.. S TEXT="",JJJ=0
.. F S JJJ=$O(^PS(50.626,PSOWRNN,1,JJJ)) Q:('JJJ) D
... I $D(^PS(50.626,PSOWRNN,1,JJJ,0)) S TEXT=TEXT_$S(TEXT="":"",1:" ")_^(0)
Q TEXT
;
GENDER2 ;
N I,WARN
S GENDER=""
I $G(PSSWRN)'["N" Q
F I=1:1 S WARN=$P(PSSWRN,",",I) Q:WARN="" D Q:GENDER'=""
.I WARN'["N" Q
.S WARN=+WARN,GENDER=$$GET1^DIQ(50.625,WARN,2,"I")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSWRNA 4664 printed Nov 22, 2024@17:44:49 Page 2
PSSWRNA ;BIR/EJW-API TO RETRIEVE WARNING LABEL LIST ;04/09/04
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**87**;9/30/97
+2 ;
+3 ;Reference to ^PSNDF(50.68 supported by DBIA 3735
+4 ;Reference to ^PS(50.625 supported by DBIA 4445
+5 ;Reference to ^PS(50.626 supported by DBIA 4446
+6 ;Reference to ^PS(50.627 supported by DBIA 4448
DRUG(XX,DFN) ; Return warning labels numbers associated with this drug
+1 ;
+2 ; entry point from Outpatient Pharmacy and Consolidated Mail Outpatient Pharmacy
+3 ; Calling method: S WARN=$$DRUG^PSSWRNA(DRUG,DFN)
+4 ;
+5 ; Input: DRUG = IEN from the DRUG file (50) ** REQUIRED **
+6 ; Input: DFN = IEN from the PATIENT file (2) ** OPTIONAL **
+7 ;
+8 ; 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".
+9 ;
+10 NEW I,PSSWSITE
+11 SET PSSWRN=""
+12 SET PSSWSITE=+$ORDER(^PS(59.7,0))
IF $PIECE($GET(^PS(59.7,PSSWSITE,10)),"^",9)="N"
DO WARNLST
+13 IF PSSWRN=""
SET PSSWRN=$PIECE($GET(^PSDRUG(XX,0)),"^",8)
+14 DO CHECKLST
+15 DO CHECK20
+16 QUIT PSSWRN
+17 ;
CHECK20 ; WARNING LABEL 20 - 'DO NOT TRANSFER' REQUIRED FOR CONTROLLED SUBSTANCES
+1 NEW I
+2 SET DEA=$PIECE($GET(^PSDRUG(XX,0)),"^",3)
+3 IF DEA=""
QUIT
+4 IF "12345"'[$EXTRACT(DEA)
QUIT
+5 IF ","_$PIECE(PSSWRN,",",1,5)_","[",20,"
QUIT
+6 IF $LENGTH(PSSWRN,",")<5
SET PSSWRN=$SELECT(PSSWRN="":20,1:PSSWRN_",20")
QUIT
+7 SET PSSWRN=$PIECE(PSSWRN,",",1,4)_",20,"_$PIECE(PSSWRN,",",5,99)
+8 FOR I=6:1:$LENGTH(PSSWRN,",")
IF $PIECE(PSSWRN,",",I)=20
SET PSSWRN=$PIECE(PSSWRN,",",1,I-1)
IF $PIECE(PSSWRN,",",I+1,99)'=""
SET PSSWRN=PSSWRN_","_$PIECE(PSSWRN,",",I+1,99)_$PIECE(PSSWRN,",",I+1,99)
QUIT
+9 QUIT
+10 ;
WARNLST ; GET WARNING LIST FROM NEW DATA SOURCE OR USER-DEFINED NEW WARNING LABEL LIST
+1 SET PSSWRN=$PIECE($GET(^PSDRUG(XX,"WARN")),"^")
IF PSSWRN'=""
QUIT
+2 ; GET WARNINGS FROM NEW COMMERCIAL SOURCE
+3 NEW PSOPROD,GCNSEQNO,SEQ,NEWWARN,I
+4 SET PSOPROD=$PIECE($GET(^PSDRUG(XX,"ND")),"^",3)
IF PSOPROD=""
QUIT
+5 SET GCNSEQNO=$$GET1^DIQ(50.68,PSOPROD,11,"I")
+6 IF GCNSEQNO=""
QUIT
GCN SET I=""
FOR
SET I=$ORDER(^PS(50.627,"B",GCNSEQNO,I))
if 'I
QUIT
IF I
Begin DoDot:1
+1 SET NEWWARN=$GET(^PS(50.627,I,0))
IF $PIECE(NEWWARN,"^")=GCNSEQNO
SET SEQ=+$PIECE(NEWWARN,"^",3)
IF SEQ>0
SET NEWWARN(SEQ)=+$PIECE(NEWWARN,"^",2)
End DoDot:1
+2 SET SEQ=0
FOR
SET SEQ=$ORDER(NEWWARN(SEQ))
if 'SEQ
QUIT
SET PSSWRN=$SELECT(PSSWRN'="":PSSWRN_",",1:"")_NEWWARN(SEQ)_"N"
+3 QUIT
WARN54 ; VERIFY ENTRY EXISTS. IF NOT, REMOVE FROM WARNING LIST
+1 IF '$DATA(^PS(54,WARN,1))
SET PSSWRN=$PIECE(PSSWRN,",",1,I-1)_$SELECT(I=1:"",1:",")_$PIECE(PSSWRN,",",I+1,99)
SET I=I-1
+2 QUIT
NEWWARN ;
+1 IF '$DATA(^PS(50.625,WARN,1))
SET PSSWRN=$PIECE(PSSWRN,",",1,I-1)_$SELECT(I=1:"",1:",")_$PIECE(PSSWRN,",",I+1,99)
SET I=I-1
+2 QUIT
CHECKLST ;
+1 NEW WARN
+2 FOR I=1:1:$LENGTH(PSSWRN,",")
SET WARN=$PIECE(PSSWRN,",",I)
IF WARN'=""
Begin DoDot:1
+3 IF WARN'["N"
DO WARN54
QUIT
+4 SET WARN=+WARN
DO GENDER
IF WARN'=""
DO NEWWARN
End DoDot:1
+5 IF $EXTRACT(PSSWRN,$LENGTH(PSSWRN))=","
SET PSSWRN=$EXTRACT(PSSWRN,1,($LENGTH(PSSWRN)-1))
+6 QUIT
GENDER ;
+1 IF $GET(DFN)=""
QUIT
+2 NEW SEX,GENDER
+3 SET GENDER=$$GET1^DIQ(50.625,WARN,2,"I")
IF GENDER=""
QUIT
+4 IF GENDER'="F"
IF GENDER'="M"
QUIT
+5 SET SEX=$$GET1^DIQ(2,DFN,.02,"I")
+6 IF $GET(SEX)=""
QUIT
+7 IF SEX'="F"
IF SEX'="M"
QUIT
+8 IF SEX'=GENDER
IF $$GET1^DIQ(50,XX,8.2,"I")="N"
Begin DoDot:1
+9 SET PSSWRN=$PIECE(PSSWRN,",",1,I-1)_$SELECT(I=1:"",1:",")_$PIECE(PSSWRN,",",I+1,99)
SET I=I-1
End DoDot:1
+10 QUIT
WTEXT(WARN,LAN) ;
+1 ;
+2 ; entry point from Outpatient Pharmacy and Consolidated Mail Outpatient Pharmacy
+3 ; Calling method: S TEXT=$$WTEXT^PSSWRNA(WARN,LAN)
+4 ;
+5 ; 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 **
+6 ; 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).
+7 ;
+8 ; LAN = Patient's PMI language preference. 2=Spanish. Anything less than 2 is English ** OPTIONAL **
+9 ;
+10 ; 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.
+11 ;
+12 SET TEXT=""
+13 IF WARN'["N"
Begin DoDot:1
+14 IF $GET(LAN)=2
Begin DoDot:2
+15 IF $DATA(^PS(54,WARN,3))
SET TEXT=^(3)
End DoDot:2
+16 IF TEXT=""
SET JJJ=0
FOR
SET JJJ=$ORDER(^PS(54,WARN,1,JJJ))
if ('JJJ)
QUIT
Begin DoDot:2
+17 IF $DATA(^PS(54,WARN,1,JJJ,0))
SET TEXT=TEXT_$SELECT(TEXT="":"",1:" ")_^(0)
End DoDot:2
End DoDot:1
+18 IF WARN["N"
Begin DoDot:1
+19 IF $GET(LAN)'=2
Begin DoDot:2
+20 SET PSOWRNN=+WARN
IF $DATA(^PS(50.625,PSOWRNN))
Begin DoDot:3
+21 SET TEXT=""
SET JJJ=0
+22 FOR
SET JJJ=$ORDER(^PS(50.625,PSOWRNN,1,JJJ))
if ('JJJ)
QUIT
Begin DoDot:4
+23 IF $DATA(^PS(50.625,PSOWRNN,1,JJJ,0))
SET TEXT=TEXT_$SELECT(TEXT="":"",1:" ")_^(0)
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+24 SET PSOWRNN=+WARN
IF $DATA(^PS(50.626,PSOWRNN))
Begin DoDot:2
+25 SET TEXT=""
SET JJJ=0
+26 FOR
SET JJJ=$ORDER(^PS(50.626,PSOWRNN,1,JJJ))
if ('JJJ)
QUIT
Begin DoDot:3
+27 IF $DATA(^PS(50.626,PSOWRNN,1,JJJ,0))
SET TEXT=TEXT_$SELECT(TEXT="":"",1:" ")_^(0)
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT TEXT
+29 ;
GENDER2 ;
+1 NEW I,WARN
+2 SET GENDER=""
+3 IF $GET(PSSWRN)'["N"
QUIT
+4 FOR I=1:1
SET WARN=$PIECE(PSSWRN,",",I)
if WARN=""
QUIT
Begin DoDot:1
+5 IF WARN'["N"
QUIT
+6 SET WARN=+WARN
SET GENDER=$$GET1^DIQ(50.625,WARN,2,"I")
End DoDot:1
if GENDER'=""
QUIT
+7 QUIT
+8 ;
