- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN50P4A 2708 printed Apr 23, 2025@18:36:55 Page 2
- PSN50P4A ;BIR/LDT - API FOR INFORMATION FROM FILE 50.416; 5 Sep 03
- +1 ;;4.0; NATIONAL DRUG FILE;**80**; 30 Oct 98
- +2 ;
- +3 ;
- SETALL ;
- +1 SET ^TMP($JOB,LIST,+PSN(1),.01)=$GET(PSN50P41(50.416,PSN(1),.01,"I"))
- +2 SET ^TMP($JOB,LIST,"B",$GET(PSN50P41(50.416,PSN(1),.01,"I")),+PSN(1))=""
- +3 SET ^TMP($JOB,LIST,+PSN(1),2)=$SELECT($GET(PSN50P41(50.416,PSN(1),2,"I"))="":"",1:PSN50P41(50.416,PSN(1),2,"I")_"^"_PSN50P41(50.416,PSN(1),2,"E"))
- +4 SET ^TMP($JOB,LIST,+PSN(1),3)=$SELECT($GET(PSN50P41(50.416,PSN(1),3,"I"))="":"",1:PSN50P41(50.416,PSN(1),3,"I")_"^"_PSN50P41(50.416,PSN(1),3,"E"))
- +5 QUIT
- +6 ;
- SETALL2 ;
- +1 SET ^TMP($JOB,LIST,+PSN(1),.01)=$GET(PSN50P41(50.416,PSN(1),.01,"I"))
- +2 SET ^TMP($JOB,LIST,"P",$GET(PSN50P41(50.416,PSN(1),.01,"I")),+PSN(1))=""
- +3 SET ^TMP($JOB,LIST,+PSN(1),2)=$SELECT($GET(PSN50P41(50.416,PSN(1),2,"I"))="":"",1:PSN50P41(50.416,PSN(1),2,"I")_"^"_PSN50P41(50.416,PSN(1),2,"E"))
- +4 QUIT
- +5 ;
- LOOP(PSN) ;
- +1 NEW PSNIEN,CNT
- SET CNT=0
- +2 SET PSNIEN=0
- FOR
- SET PSNIEN=$ORDER(^PS(50.416,PSNIEN))
- if 'PSNIEN
- QUIT
- DO @(PSN)
- +3 SET ^TMP($JOB,LIST,0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
- +4 QUIT
- +5 ;
- 1 ;
- +1 IF +$GET(PSNFL)>0
- IF $PIECE($GET(^PS(50.416,PSNIEN,2)),"^")]""
- IF $PIECE($GET(^(2)),"^")'>PSNFL
- QUIT
- +2 KILL PSN50P41
- DO GETS^DIQ(50.416,+PSNIEN,".01;2;3","IE","PSN50P41")
- SET PSN(1)=0
- Begin DoDot:1
- +3 FOR
- SET PSN(1)=$ORDER(PSN50P41(50.416,PSN(1)))
- if 'PSN(1)
- QUIT
- DO SETALL
- SET CNT=CNT+1
- End DoDot:1
- +4 KILL PSN50P41,^TMP("DILIST",$JOB)
- +5 QUIT
- +6 ;
- 2 ;
- +1 NEW CNT1
- +2 IF $ORDER(^PS(50.416,+PSNIEN,1,0))
- IF '$DATA(^PS(50.416,+PSNIEN,1,0))
- DO SETHDR
- +3 KILL ^TMP("PSNAPD",$JOB)
- DO GETS^DIQ(50.416,+PSNIEN,".01;1*","IE","^TMP(""PSNAPD"",$J)")
- SET PSN(1)=0
- +4 FOR
- SET PSN(1)=$ORDER(^TMP("PSNAPD",$JOB,50.416,PSN(1)))
- if 'PSN(1)
- QUIT
- Begin DoDot:1
- +5 SET ^TMP($JOB,LIST,+PSN(1),.01)=$GET(^TMP("PSNAPD",$JOB,50.416,PSN(1),.01,"I"))
- +6 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSNAPD",$JOB,50.416,PSN(1),.01,"I")),+PSN(1))=""
- +7 SET (CNT1,PSN(2))=0
- FOR
- SET PSN(2)=$ORDER(^TMP("PSNAPD",$JOB,50.4161,PSN(2)))
- if 'PSN(2)
- QUIT
- Begin DoDot:2
- +8 SET ^TMP($JOB,LIST,+PSN(1),"ID",+PSN(2),.01)=$GET(^TMP("PSNAPD",$JOB,50.4161,PSN(2),.01,"I"))
- SET CNT1=CNT1+1
- End DoDot:2
- +9 SET ^TMP($JOB,LIST,+PSN(1),"ID",0)=$SELECT($GET(CNT)>0:CNT,1:"-1^NO DATA FOUND")
- End DoDot:1
- +10 KILL ^TMP("PSNAPD",$JOB),^TMP("DILIST",$JOB)
- +11 QUIT
- +12 ;
- LOOP2 ;
- +1 NEW PSNIEN,PSNIEN2,CNT
- SET CNT=0
- +2 SET PSNIEN=""
- FOR
- SET PSNIEN=$ORDER(^PS(50.416,"P",PSNIEN))
- if PSNIEN=""
- QUIT
- SET PSNIEN2=0
- FOR
- SET PSNIEN2=$ORDER(^PS(50.416,"P",PSNIEN,PSNIEN2))
- if 'PSNIEN2
- QUIT
- Begin DoDot:1
- +3 KILL PSN50P41
- DO GETS^DIQ(50.416,+PSNIEN2,".01;2*","IE","PSN50P41")
- SET PSN(1)=0
- Begin DoDot:2
- +4 FOR
- SET PSN(1)=$ORDER(PSN50P41(50.416,PSN(1)))
- if 'PSN(1)
- QUIT
- DO SETALL2
- SET CNT=CNT+1
- End DoDot:2
- End DoDot:1
- +5 SET ^TMP($JOB,LIST,0)=+CNT
- +6 QUIT
- +7 ;
- SETSCRN ;Set Screen for inactive Drug Ingredients
- +1 ;Naked reference below refers to ^PS(50.416,+Y,2)
- +2 SET SCR("S")="S ND=$G(^(2)) I ND=""""!(ND>PSNFL)"
- +3 QUIT
- +4 ;
- SETHDR ;
- +1 NEW PSNCNT,PSNNUM
- SET (PSNCNT,PSNNUM)=0
- +2 FOR
- SET PSNNUM=$ORDER(^PS(50.416,+PSNIEN,1,PSNNUM))
- if 'PSNNUM
- QUIT
- SET PSNCNT=PSNCNT+1
- +3 SET ^PS(50.416,+PSNIEN,1,0)="^50.4161A^"_PSNCNT_"^"_PSNCNT
- +4 QUIT
