- 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 Jan 18, 2025@03:35:30 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 ;