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

PSN5067.m

Go to the documentation of this file.
  1. PSN5067 ;BIR/LDT - API FOR INFORMATION FROM FILE 50.67; 5 Sep 03
  1. ;;4.0; NATIONAL DRUG FILE;**109**; 30 Oct 98
  1. ;
  1. ALL(PSNIEN,PSNFT,PSNFL,LIST) ;
  1. ;PSNIEN - IEN of entry in NDC/UPN file (#50.67).
  1. ;PSNFT - Free Text TRADE NAME in NDC/UPN file (#50.67).
  1. ;PSNFL - Inactive flag - "" - All entries.
  1. ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
  1. ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where
  1. ; Field Number is the Field Number of the data piece being returned.
  1. ;Returns SEQUENCE NUMBER field (#.01), NDC field (#1), UPN field (#2), MANUFACTURER field (#3), TRADE NAME field (#4),
  1. ;VA PRODUCT NAME field (#5), INACTIVATION DATE field (#7), PACKAGE SIZE field (#8), PACKAGE TYPE field (#9), and
  1. ;OTX/RX INDICATOR field (#10) of the NDC/UPN file (#50.67).
  1. N DIERR,ZZERR,PSN5067,PSN,SCR
  1. I $G(LIST)']"" Q
  1. K ^TMP($J,LIST)
  1. I $G(PSNIEN)']"",($G(PSNFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. I $G(PSNIEN)]"",(+$G(PSNIEN)'>0) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. S SCR("S")=""
  1. I +$G(PSNFL)>0 N ND D SETSCRN
  1. I $G(PSNIEN)]"" N PSNIEN2 S PSNIEN2=$$FIND1^DIC(50.67,"","B","`"_PSNIEN,,SCR("S"),"") D
  1. .I +PSNIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .S ^TMP($J,LIST,0)=1
  1. .D GETS^DIQ(50.67,+PSNIEN2,".01:10","IE","PSN5067") S PSN(1)=0
  1. .F S PSN(1)=$O(PSN5067(50.67,PSN(1))) Q:'PSN(1) D SETZRO
  1. I $G(PSNIEN)="",$G(PSNFT)]"" D
  1. .I PSNFT["??" D LOOP Q
  1. .D FIND^DIC(50.67,,"@;.01;1","QP",PSNFT,,"T",SCR("S"),,"")
  1. .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSNXX S PSNXX=0 F S PSNXX=$O(^TMP("DILIST",$J,PSNXX)) Q:'PSNXX D
  1. ..S PSNIEN=+^TMP("DILIST",$J,PSNXX,0) K PSN5067 D GETS^DIQ(50.67,+PSNIEN,".01:10","IE","PSN5067") S PSN(1)=0
  1. ..F S PSN(1)=$O(PSN5067(50.67,PSN(1))) Q:'PSN(1) D SETZRO
  1. K ^TMP("DILIST",$J)
  1. Q
  1. ;
  1. SETZRO ;
  1. S ^TMP($J,LIST,+PSN(1),.01)=$G(PSN5067(50.67,PSN(1),.01,"I"))
  1. S ^TMP($J,LIST,+PSN(1),1)=$G(PSN5067(50.67,PSN(1),1,"I"))
  1. S ^TMP($J,LIST,+PSN(1),2)=$G(PSN5067(50.67,PSN(1),2,"I"))
  1. S ^TMP($J,LIST,+PSN(1),3)=$S($G(PSN5067(50.67,PSN(1),3,"I"))="":"",1:PSN5067(50.67,PSN(1),3,"I")_"^"_PSN5067(50.67,PSN(1),3,"E"))
  1. S ^TMP($J,LIST,+PSN(1),4)=$G(PSN5067(50.67,PSN(1),4,"I"))
  1. I $G(PSN5067(50.67,PSN(1),4,"I"))'="" S ^TMP($J,LIST,"B",$G(PSN5067(50.67,PSN(1),4,"I")),+PSN(1))=""
  1. S ^TMP($J,LIST,+PSN(1),5)=$S($G(PSN5067(50.67,PSN(1),5,"I"))="":"",1:PSN5067(50.67,PSN(1),5,"I")_"^"_PSN5067(50.67,PSN(1),5,"E"))
  1. S ^TMP($J,LIST,+PSN(1),7)=$S($G(PSN5067(50.67,PSN(1),7,"I"))="":"",1:PSN5067(50.67,PSN(1),7,"I")_"^"_PSN5067(50.67,PSN(1),7,"E"))
  1. S ^TMP($J,LIST,+PSN(1),8)=$S($G(PSN5067(50.67,PSN(1),8,"I"))="":"",1:PSN5067(50.67,PSN(1),8,"I")_"^"_PSN5067(50.67,PSN(1),8,"E"))
  1. S ^TMP($J,LIST,+PSN(1),9)=$S($G(PSN5067(50.67,PSN(1),9,"I"))="":"",1:PSN5067(50.67,PSN(1),9,"I")_"^"_PSN5067(50.67,PSN(1),9,"E"))
  1. S ^TMP($J,LIST,+PSN(1),10)=$S($G(PSN5067(50.67,PSN(1),10,"I"))="":"",1:PSN5067(50.67,PSN(1),10,"I")_"^"_PSN5067(50.67,PSN(1),10,"E"))
  1. Q
  1. ;
  1. LOOP ;
  1. N PSN567D,PSN567E,PSN567RX,PSN567ND,PSNVAL
  1. D FIELD^DID(50.67,10,"Z","POINTER","PSN567D","PSN567E") S PSN567RX=$G(PSN567D("POINTER"))
  1. N PSNENCT
  1. S PSNENCT=0
  1. S PSNVAL=0 F S PSNVAL=$O(^PSNDF(50.67,PSNVAL)) Q:'PSNVAL D
  1. .I $P($G(^PSNDF(50.67,PSNVAL,0)),"^")="" Q
  1. .I $G(PSNFL),$P($G(^PSNDF(50.67,PSNVAL,0)),"^",7),$P($G(^(0)),"^",7)'>PSNFL Q
  1. .S PSN567ND=$G(^PSNDF(50.67,PSNVAL,0))
  1. .S ^TMP($J,LIST,+PSNVAL,.01)=$P(PSN567ND,"^")
  1. .I $P(PSN567ND,"^",5)'="" S ^TMP($J,LIST,"B",$P(PSN567ND,"^",5),+PSNVAL)=""
  1. .S ^TMP($J,LIST,+PSNVAL,1)=$P(PSN567ND,"^",2)
  1. .S ^TMP($J,LIST,+PSNVAL,2)=$P(PSN567ND,"^",3)
  1. .S ^TMP($J,LIST,+PSNVAL,3)=$S($P(PSN567ND,"^",4):$P(PSN567ND,"^",4)_"^"_$P($G(^PS(55.95,+$P(PSN567ND,"^",4),0)),"^"),1:"")
  1. .S ^TMP($J,LIST,+PSNVAL,4)=$P(PSN567ND,"^",5)
  1. .S ^TMP($J,LIST,+PSNVAL,5)=$S($P(PSN567ND,"^",6):$P(PSN567ND,"^",6)_"^"_$P($G(^PSNDF(50.68,+$P(PSN567ND,"^",6),0)),"^"),1:"")
  1. .N Y S Y=$P(PSN567ND,"^",7) D
  1. ..I Y S ^TMP($J,LIST,+PSNVAL,7)=$G(Y) X ^DD("DD") S ^TMP($J,LIST,+PSNVAL,7)=^TMP($J,LIST,+PSNVAL,7)_"^"_$G(Y) Q
  1. ..S ^TMP($J,LIST,+PSNVAL,7)=""
  1. .S ^TMP($J,LIST,+PSNVAL,8)=$S($P(PSN567ND,"^",8):$P(PSN567ND,"^",8)_"^"_$P($G(^PS(50.609,+$P(PSN567ND,"^",8),0)),"^"),1:"")
  1. .S ^TMP($J,LIST,+PSNVAL,9)=$S($P(PSN567ND,"^",9):$P(PSN567ND,"^",9)_"^"_$P($G(^PS(50.608,+$P(PSN567ND,"^",9),0)),"^"),1:"")
  1. .N PSN567NR S PSN567NR=$P(PSN567ND,"^",10) D
  1. ..I PSN567NR'="",PSN567RX'="",PSN567RX[(PSN567NR_":") S ^TMP($J,LIST,+PSNVAL,10)=PSN567NR_"^"_$P($E(PSN567RX,$F(PSN567RX,(PSN567NR_":")),999),";") Q
  1. ..S ^TMP($J,LIST,+PSNVAL,10)=""
  1. .S PSNENCT=PSNENCT+1
  1. S ^TMP($J,LIST,0)=$S($G(PSNENCT):$G(PSNENCT),1:"-1^NO DATA FOUND")
  1. Q
  1. ;
  1. SETSCRN ;
  1. S SCR("S")="S ND=$P($G(^PSNDF(50.67,+Y,0)),""^"",7) I ND=""""!(ND>PSNFL)"
  1. Q