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

PSN50P4A.m

Go to the documentation of this file.
PSN50P4A ;BIR/LDT - API FOR INFORMATION FROM FILE 50.416; 5 Sep 03
 ;;4.0; NATIONAL DRUG FILE;**80**; 30 Oct 98
 ;
 ;
SETALL ;
 S ^TMP($J,LIST,+PSN(1),.01)=$G(PSN50P41(50.416,PSN(1),.01,"I"))
 S ^TMP($J,LIST,"B",$G(PSN50P41(50.416,PSN(1),.01,"I")),+PSN(1))=""
 S ^TMP($J,LIST,+PSN(1),2)=$S($G(PSN50P41(50.416,PSN(1),2,"I"))="":"",1:PSN50P41(50.416,PSN(1),2,"I")_"^"_PSN50P41(50.416,PSN(1),2,"E"))
 S ^TMP($J,LIST,+PSN(1),3)=$S($G(PSN50P41(50.416,PSN(1),3,"I"))="":"",1:PSN50P41(50.416,PSN(1),3,"I")_"^"_PSN50P41(50.416,PSN(1),3,"E"))
 Q
 ;
SETALL2 ;
 S ^TMP($J,LIST,+PSN(1),.01)=$G(PSN50P41(50.416,PSN(1),.01,"I"))
 S ^TMP($J,LIST,"P",$G(PSN50P41(50.416,PSN(1),.01,"I")),+PSN(1))=""
 S ^TMP($J,LIST,+PSN(1),2)=$S($G(PSN50P41(50.416,PSN(1),2,"I"))="":"",1:PSN50P41(50.416,PSN(1),2,"I")_"^"_PSN50P41(50.416,PSN(1),2,"E"))
 Q
 ;
LOOP(PSN) ;
 N PSNIEN,CNT S CNT=0
 S PSNIEN=0 F  S PSNIEN=$O(^PS(50.416,PSNIEN)) Q:'PSNIEN  D @(PSN)
 S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
 Q
 ;
1 ;
 I +$G(PSNFL)>0,$P($G(^PS(50.416,PSNIEN,2)),"^")]"",$P($G(^(2)),"^")'>PSNFL Q
 K PSN50P41 D GETS^DIQ(50.416,+PSNIEN,".01;2;3","IE","PSN50P41") S PSN(1)=0 D
 .F  S PSN(1)=$O(PSN50P41(50.416,PSN(1))) Q:'PSN(1)  D SETALL S CNT=CNT+1
 K PSN50P41,^TMP("DILIST",$J)
 Q
 ;
2 ;
 N CNT1
 I $O(^PS(50.416,+PSNIEN,1,0)),'$D(^PS(50.416,+PSNIEN,1,0)) D SETHDR
 K ^TMP("PSNAPD",$J) D GETS^DIQ(50.416,+PSNIEN,".01;1*","IE","^TMP(""PSNAPD"",$J)") S PSN(1)=0
 F  S PSN(1)=$O(^TMP("PSNAPD",$J,50.416,PSN(1))) Q:'PSN(1)   D
 .S ^TMP($J,LIST,+PSN(1),.01)=$G(^TMP("PSNAPD",$J,50.416,PSN(1),.01,"I"))
 .S ^TMP($J,LIST,"B",$G(^TMP("PSNAPD",$J,50.416,PSN(1),.01,"I")),+PSN(1))=""
 .S (CNT1,PSN(2))=0 F  S PSN(2)=$O(^TMP("PSNAPD",$J,50.4161,PSN(2))) Q:'PSN(2)  D
 ..S ^TMP($J,LIST,+PSN(1),"ID",+PSN(2),.01)=$G(^TMP("PSNAPD",$J,50.4161,PSN(2),.01,"I")),CNT1=CNT1+1
 .S ^TMP($J,LIST,+PSN(1),"ID",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
 K ^TMP("PSNAPD",$J),^TMP("DILIST",$J)
 Q
 ;
LOOP2 ;
 N PSNIEN,PSNIEN2,CNT S CNT=0
 S PSNIEN="" F  S PSNIEN=$O(^PS(50.416,"P",PSNIEN)) Q:PSNIEN=""  S PSNIEN2=0 F  S PSNIEN2=$O(^PS(50.416,"P",PSNIEN,PSNIEN2)) Q:'PSNIEN2  D
 .K PSN50P41 D GETS^DIQ(50.416,+PSNIEN2,".01;2*","IE","PSN50P41") S PSN(1)=0 D
 ..F  S PSN(1)=$O(PSN50P41(50.416,PSN(1))) Q:'PSN(1)  D SETALL2 S CNT=CNT+1
 S ^TMP($J,LIST,0)=+CNT
 Q
 ;
SETSCRN ;Set Screen for inactive Drug Ingredients
 ;Naked reference below refers to ^PS(50.416,+Y,2)
 S SCR("S")="S ND=$G(^(2)) I ND=""""!(ND>PSNFL)"
 Q
 ;
SETHDR ;
 N PSNCNT,PSNNUM S (PSNCNT,PSNNUM)=0
 F  S PSNNUM=$O(^PS(50.416,+PSNIEN,1,PSNNUM)) Q:'PSNNUM  S PSNCNT=PSNCNT+1
 S ^PS(50.416,+PSNIEN,1,0)="^50.4161A^"_PSNCNT_"^"_PSNCNT
 Q