- PSN50P41 ;BIR/LDT - API FOR INFORMATION FROM FILE 50.416; 5 Sep 03
- ;;4.0; NATIONAL DRUG FILE;**80**; 30 Oct 98
- ;
- B() ;RETURNS THE GLOBAL ROOT OF THE "B" CROSSREFERENCE IN ^PS(50.416
- Q "^PS(50.416,""B"")"
- ;
- ZERO(PSNIEN,PSNFT,PSNFL,LIST) ;
- ;PSNIEN - IEN of entry in DRUG INGREDIENTS file (#50.416).
- ;PSNFT - Free Text name in DRUG INGREDIENTS file (#50.416).
- ;PSNFL - Inactive flag - "" - All entries.
- ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
- ; Field Number of the data piece being returned.
- ;Returns NAME field (#.01), PRIMARY INGREDIENT field (#2), and INACTIVATION DATE field (#3)
- ;of DRUG INGREDIENTS file (#50.416).
- N DIERR,ZZERR,PSN50P41,SCR,PSN
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I $G(PSNIEN)']"",($G(PSNFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I $G(PSNIEN)]"",(+$G(PSNIEN)'>0) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- S SCR("S")=""
- I +$G(PSNFL)>0 D SETSCRN^PSN50P4A
- I $G(PSNIEN)]"" N PSNIEN2 S PSNIEN2=$$FIND1^DIC(50.416,"","A","`"_PSNIEN,,SCR("S"),"") D
- .I +PSNIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .S ^TMP($J,LIST,0)=1
- .D GETS^DIQ(50.416,+PSNIEN2,".01;2;3","IE","PSN50P41") S PSN(1)=0
- .F S PSN(1)=$O(PSN50P41(50.416,PSN(1))) Q:'PSN(1) D SETALL^PSN50P4A
- I $G(PSNIEN)="",$G(PSNFT)]"" D
- .I PSNFT["??" D LOOP^PSN50P4A(1) Q
- .D FIND^DIC(50.416,,"@;.01;","QP",PSNFT,,"B",SCR("S"),,"")
- .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .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
- ..S PSNIEN=+^TMP("DILIST",$J,PSNXX,0) K PSN50P41 D GETS^DIQ(50.416,+PSNIEN,".01;2;3","IE","PSN50P41") S PSN(1)=0
- ..F S PSN(1)=$O(PSN50P41(50.416,PSN(1))) Q:'PSN(1) D SETALL^PSN50P4A K PSN50P41
- K ^TMP("DILIST",$J)
- Q
- ;
- NAME(PSNFT,LIST) ;
- ;PSNFT - Free Text name in DRUG INGREDIENTS file (#50.416).
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
- ; Field Number of the data piece being returned.
- ;Returns NAME field (#.01), and PRIMARY INGREDIENT field (#2) of DRUG INGREDIENTS file (#50.416).
- N DIERR,ZZERR,PSN50P41,PSN
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I ($G(PSNFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I PSNFT["??" D LOOP2^PSN50P4A Q
- D FIND^DIC(50.416,,"@;.01;","QP",PSNFT,,"P",,,"")
- I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- 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
- .S PSNIEN=+^TMP("DILIST",$J,PSNXX,0) K PSN50P41 D GETS^DIQ(50.416,+PSNIEN,".01;2;","IE","PSN50P41") S PSN(1)=0
- .F S PSN(1)=$O(PSN50P41(50.416,PSN(1))) Q:'PSN(1) D SETALL2^PSN50P4A K PSN50P41
- K ^TMP("DILIST",$J)
- Q
- ;
- ID(PSNIEN,PSNFT,LIST) ;
- ;PSNIEN - IEN of entry in DRUG INGREDIENTS file (#50.416).
- ;PSNFT - Free Text name in DRUG INGREDIENTS file (#50.416).
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
- ; Field Number of the data piece being returned.
- ;Returns DRUG IDENTIFIER field (#.01) of the DRUG IDENTIFIER multiple (#50.4161) of DRUG INGREDIENTS file (#50.416).
- N DIERR,ZZERR,PSN50P41,PSN
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I +$G(PSNIEN)'>0,($G(PSNFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I $G(PSNIEN)]"",(+$G(PSNIEN)'>0) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I +$G(PSNIEN)>0 N PSNIEN2 S PSNIEN2=$$FIND1^DIC(50.416,"","A","`"_PSNIEN,,,"") D
- .I +PSNIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .S ^TMP($J,LIST,0)=1
- .S PSNIEN=PSNIEN2 I $O(^PS(50.416,+PSNIEN,1,0)),'$D(^PS(50.416,+PSNIEN,1,0)) D SETHDR^PSN50P4A
- .D GETS^DIQ(50.416,+PSNIEN2,".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 (CNT,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")),CNT=CNT+1
- ..S ^TMP($J,LIST,+PSN(1),"ID",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
- I $G(PSNIEN)="",$G(PSNFT)]"" D
- .I PSNFT["??" D LOOP^PSN50P4A(2) Q
- .D FIND^DIC(50.416,,"@;.01;","QP",PSNFT,,"B",,,"")
- .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .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
- ..S PSNIEN=+^TMP("DILIST",$J,PSNXX,0)
- ..I $O(^PS(50.416,+PSNIEN,1,0)),'$D(^PS(50.416,+PSNIEN,1,0)) D SETHDR^PSN50P4A
- ..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 K PSN50P41
- ...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 (CNT,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")),CNT=CNT+1
- ...S ^TMP($J,LIST,+PSN(1),"ID",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
- K ^TMP("DILIST",$J),^TMP("PSNAPD",$J)
- Q
- ;
- APS(PSNPI,LIST) ;
- ;PSNPI - PRIMARY INGREDIENT field (#2) of the DRUG INGREDIENTS file (#50.416)
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
- ; Field Number of the data piece being returned.
- ;Returns DRUG IDENTIFIER field (#.01) of the DRUG IDENTIFIER multiple (#50.4161) of DRUG INGREDIENTS file (#50.416).
- N DIERR,ZZERR,PSN50P41,PSN,CNT
- I $G(LIST)']"" Q
- K ^TMP($J,LIST)
- I +$G(PSNPI)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- ;Naked reference below refers to ^PS(50.416,+Y,0)
- S SCR("S")="S ND=$G(^(0)) I $P(ND,""^"",2)=PSNPI"
- I +$G(PSNPI)>0 D FIND^DIC(50.416,,"@;.01","QP",PSNPI,,"APS",SCR("S"),"")
- I +^TMP("DILIST",$J,0)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
- S PSN(1)=0 F S PSN(1)=$O(^TMP("DILIST",$J,PSN(1))) Q:'PSN(1) D
- .S PSNIEN=+^TMP("DILIST",$J,PSN(1),0)
- .I $O(^PS(50.416,+PSNIEN,1,0)),'$D(^PS(50.416,+PSNIEN,1,0)) D SETHDR^PSN50P4A
- .K ^TMP("PSNAPS",$J) D GETS^DIQ(50.416,+PSNIEN,".01;1*","IE","^TMP(""PSNAPS"",$J)") S PSN(2)=0
- .F S PSN(2)=$O(^TMP("PSNAPS",$J,50.416,PSN(2))) Q:'PSN(2) D
- ..S ^TMP($J,LIST,+PSN(2),.01)=$G(^TMP("PSNAPS",$J,50.416,PSN(2),.01,"I"))
- ..S ^TMP($J,LIST,"APS",$G(^TMP("PSNAPS",$J,50.416,PSN(2),.01,"I")),+PSN(2))=""
- ..S (CNT,PSN(3))=0 F S PSN(3)=$O(^TMP("PSNAPS",$J,50.4161,PSN(3))) Q:'PSN(3) D
- ...S ^TMP($J,LIST,+PSN(2),"ID",+PSN(3),.01)=$G(^TMP("PSNAPS",$J,50.4161,PSN(3),.01,"I")),CNT=CNT+1
- ...S ^TMP($J,LIST,+PSN(2),"ID",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
- K ^TMP("DILIST",$J),^TMP("PSNAPS",$J)
- Q
- ;
- APD(PSNID,LIST) ;
- ;PSNID - DRUG IDENTIFIER field (#.01) of the DRUG IDENTIFIER multiple of the DRUG INGREDIENTS file (#50.416)
- ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
- ; Field Number of the data piece being returned.
- ;Returns NAME field (#.01), PRIMARY INGREDIENTS field (#2), and DRUG IDENTIFIER field (#.01)
- ;of the DRUG IDENTIFIER multiple (#50.4161) of DRUG INGREDIENTS file (#50.416).
- N DIERR,ZZERR,PSN,CNT,CNT1
- I $G(LIST)']"" Q
- K ^TMP($J,LIST),^TMP("PSNAPD",$J)
- I $G(PSNID)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- I $L(PSNID)>30!($L(PSNID)<3)!'(PSNID?1.N1"A"1.N) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- D FIND^DIC(50.416,,"@;.01","QP",PSNID,,"APD",,,"")
- I +^TMP("DILIST",$J,0)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- ;S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
- S (CNT1,PSN(1))=0 F S PSN(1)=$O(^TMP("DILIST",$J,PSN(1))) Q:'PSN(1) D
- .S PSNIEN=+^TMP("DILIST",$J,PSN(1),0)
- .I $O(^PS(50.416,+PSNIEN,1,0)),'$D(^PS(50.416,+PSNIEN,1,0)) D SETHDR^PSN50P4A
- .K ^TMP("PSNAPD",$J) D GETS^DIQ(50.416,+PSNIEN,".01;2;1*","IE","^TMP(""PSNAPD"",$J)") D
- ..Q:'$D(^PS(50.416,"APD",PSNID,+PSNIEN))
- ..S CNT1=CNT1+1
- ..S (CNT,PSN(2))=0 F S PSN(2)=$O(^TMP("PSNAPD",$J,50.4161,PSN(2))) Q:'PSN(2) D
- ...S ^TMP($J,LIST,+PSNIEN,"ID",+PSN(2),.01)=$G(^TMP("PSNAPD",$J,50.4161,PSN(2),.01,"I")),CNT=CNT+1
- ..S ^TMP($J,LIST,+PSNIEN,"ID",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
- ..S PSN(3)=0 F S PSN(3)=$O(^TMP("PSNAPD",$J,50.416,PSN(3))) Q:'PSN(3) D
- ...S ^TMP($J,LIST,+PSN(3),.01)=$G(^TMP("PSNAPD",$J,50.416,PSN(3),.01,"I"))
- ...S ^TMP($J,LIST,"APD",$G(^TMP("PSNAPD",$J,50.416,PSN(3),.01,"I")),+PSN(3))=""
- ...S ^TMP($J,LIST,+PSN(3),2)=$S($G(^TMP("PSNAPD",$J,50.416,PSN(3),2,"I"))="":"",1:^TMP("PSNAPD",$J,50.416,PSN(3),2,"I")_"^"_^TMP("PSNAPD",$J,50.416,PSN(3),2,"E"))
- S ^TMP($J,LIST,0)=$S(CNT1>0:CNT1,1:"-1^NO DATA FOUND")
- K ^TMP("DILIST",$J),^TMP("PSNAPD",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN50P41 9102 printed Jan 18, 2025@03:23:36 Page 2
- PSN50P41 ;BIR/LDT - API FOR INFORMATION FROM FILE 50.416; 5 Sep 03
- +1 ;;4.0; NATIONAL DRUG FILE;**80**; 30 Oct 98
- +2 ;
- B() ;RETURNS THE GLOBAL ROOT OF THE "B" CROSSREFERENCE IN ^PS(50.416
- +1 QUIT "^PS(50.416,""B"")"
- +2 ;
- ZERO(PSNIEN,PSNFT,PSNFL,LIST) ;
- +1 ;PSNIEN - IEN of entry in DRUG INGREDIENTS file (#50.416).
- +2 ;PSNFT - Free Text name in DRUG INGREDIENTS file (#50.416).
- +3 ;PSNFL - Inactive flag - "" - All entries.
- +4 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
- +5 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
- +6 ; Field Number of the data piece being returned.
- +7 ;Returns NAME field (#.01), PRIMARY INGREDIENT field (#2), and INACTIVATION DATE field (#3)
- +8 ;of DRUG INGREDIENTS file (#50.416).
- +9 NEW DIERR,ZZERR,PSN50P41,SCR,PSN
- +10 IF $GET(LIST)']""
- QUIT
- +11 KILL ^TMP($JOB,LIST)
- +12 IF $GET(PSNIEN)']""
- IF ($GET(PSNFT)']"")
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +13 IF $GET(PSNIEN)]""
- IF (+$GET(PSNIEN)'>0)
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +14 SET SCR("S")=""
- +15 IF +$GET(PSNFL)>0
- DO SETSCRN^PSN50P4A
- +16 IF $GET(PSNIEN)]""
- NEW PSNIEN2
- SET PSNIEN2=$$FIND1^DIC(50.416,"","A","`"_PSNIEN,,SCR("S"),"")
- Begin DoDot:1
- +17 IF +PSNIEN2'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +18 SET ^TMP($JOB,LIST,0)=1
- +19 DO GETS^DIQ(50.416,+PSNIEN2,".01;2;3","IE","PSN50P41")
- SET PSN(1)=0
- +20 FOR
- SET PSN(1)=$ORDER(PSN50P41(50.416,PSN(1)))
- if 'PSN(1)
- QUIT
- DO SETALL^PSN50P4A
- End DoDot:1
- +21 IF $GET(PSNIEN)=""
- IF $GET(PSNFT)]""
- Begin DoDot:1
- +22 IF PSNFT["??"
- DO LOOP^PSN50P4A(1)
- QUIT
- +23 DO FIND^DIC(50.416,,"@;.01;","QP",PSNFT,,"B",SCR("S"),,"")
- +24 IF +$GET(^TMP("DILIST",$JOB,0))=0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +25 IF +^TMP("DILIST",$JOB,0)>0
- SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- NEW PSNXX
- SET PSNXX=0
- FOR
- SET PSNXX=$ORDER(^TMP("DILIST",$JOB,PSNXX))
- if 'PSNXX
- QUIT
- Begin DoDot:2
- +26 SET PSNIEN=+^TMP("DILIST",$JOB,PSNXX,0)
- KILL PSN50P41
- DO GETS^DIQ(50.416,+PSNIEN,".01;2;3","IE","PSN50P41")
- SET PSN(1)=0
- +27 FOR
- SET PSN(1)=$ORDER(PSN50P41(50.416,PSN(1)))
- if 'PSN(1)
- QUIT
- DO SETALL^PSN50P4A
- KILL PSN50P41
- End DoDot:2
- End DoDot:1
- +28 KILL ^TMP("DILIST",$JOB)
- +29 QUIT
- +30 ;
- NAME(PSNFT,LIST) ;
- +1 ;PSNFT - Free Text name in DRUG INGREDIENTS file (#50.416).
- +2 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
- +3 ; Field Number of the data piece being returned.
- +4 ;Returns NAME field (#.01), and PRIMARY INGREDIENT field (#2) of DRUG INGREDIENTS file (#50.416).
- +5 NEW DIERR,ZZERR,PSN50P41,PSN
- +6 IF $GET(LIST)']""
- QUIT
- +7 KILL ^TMP($JOB,LIST)
- +8 IF ($GET(PSNFT)']"")
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +9 IF PSNFT["??"
- DO LOOP2^PSN50P4A
- QUIT
- +10 DO FIND^DIC(50.416,,"@;.01;","QP",PSNFT,,"P",,,"")
- +11 IF +$GET(^TMP("DILIST",$JOB,0))=0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +12 IF +^TMP("DILIST",$JOB,0)>0
- SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- NEW PSNXX
- SET PSNXX=0
- FOR
- SET PSNXX=$ORDER(^TMP("DILIST",$JOB,PSNXX))
- if 'PSNXX
- QUIT
- Begin DoDot:1
- +13 SET PSNIEN=+^TMP("DILIST",$JOB,PSNXX,0)
- KILL PSN50P41
- DO GETS^DIQ(50.416,+PSNIEN,".01;2;","IE","PSN50P41")
- SET PSN(1)=0
- +14 FOR
- SET PSN(1)=$ORDER(PSN50P41(50.416,PSN(1)))
- if 'PSN(1)
- QUIT
- DO SETALL2^PSN50P4A
- KILL PSN50P41
- End DoDot:1
- +15 KILL ^TMP("DILIST",$JOB)
- +16 QUIT
- +17 ;
- ID(PSNIEN,PSNFT,LIST) ;
- +1 ;PSNIEN - IEN of entry in DRUG INGREDIENTS file (#50.416).
- +2 ;PSNFT - Free Text name in DRUG INGREDIENTS file (#50.416).
- +3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
- +4 ; Field Number of the data piece being returned.
- +5 ;Returns DRUG IDENTIFIER field (#.01) of the DRUG IDENTIFIER multiple (#50.4161) of DRUG INGREDIENTS file (#50.416).
- +6 NEW DIERR,ZZERR,PSN50P41,PSN
- +7 IF $GET(LIST)']""
- QUIT
- +8 KILL ^TMP($JOB,LIST)
- +9 IF +$GET(PSNIEN)'>0
- IF ($GET(PSNFT)']"")
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +10 IF $GET(PSNIEN)]""
- IF (+$GET(PSNIEN)'>0)
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +11 IF +$GET(PSNIEN)>0
- NEW PSNIEN2
- SET PSNIEN2=$$FIND1^DIC(50.416,"","A","`"_PSNIEN,,,"")
- Begin DoDot:1
- +12 IF +PSNIEN2'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +13 SET ^TMP($JOB,LIST,0)=1
- +14 SET PSNIEN=PSNIEN2
- IF $ORDER(^PS(50.416,+PSNIEN,1,0))
- IF '$DATA(^PS(50.416,+PSNIEN,1,0))
- DO SETHDR^PSN50P4A
- +15 DO GETS^DIQ(50.416,+PSNIEN2,".01;1*","IE","^TMP(""PSNAPD"",$J)")
- SET PSN(1)=0
- +16 FOR
- SET PSN(1)=$ORDER(^TMP("PSNAPD",$JOB,50.416,PSN(1)))
- if 'PSN(1)
- QUIT
- Begin DoDot:2
- +17 SET ^TMP($JOB,LIST,+PSN(1),.01)=$GET(^TMP("PSNAPD",$JOB,50.416,PSN(1),.01,"I"))
- +18 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSNAPD",$JOB,50.416,PSN(1),.01,"I")),+PSN(1))=""
- +19 SET (CNT,PSN(2))=0
- FOR
- SET PSN(2)=$ORDER(^TMP("PSNAPD",$JOB,50.4161,PSN(2)))
- if 'PSN(2)
- QUIT
- Begin DoDot:3
- +20 SET ^TMP($JOB,LIST,+PSN(1),"ID",+PSN(2),.01)=$GET(^TMP("PSNAPD",$JOB,50.4161,PSN(2),.01,"I"))
- SET CNT=CNT+1
- End DoDot:3
- +21 SET ^TMP($JOB,LIST,+PSN(1),"ID",0)=$SELECT($GET(CNT)>0:CNT,1:"-1^NO DATA FOUND")
- End DoDot:2
- End DoDot:1
- +22 IF $GET(PSNIEN)=""
- IF $GET(PSNFT)]""
- Begin DoDot:1
- +23 IF PSNFT["??"
- DO LOOP^PSN50P4A(2)
- QUIT
- +24 DO FIND^DIC(50.416,,"@;.01;","QP",PSNFT,,"B",,,"")
- +25 IF +$GET(^TMP("DILIST",$JOB,0))=0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +26 IF +^TMP("DILIST",$JOB,0)>0
- SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- NEW PSNXX
- SET PSNXX=0
- FOR
- SET PSNXX=$ORDER(^TMP("DILIST",$JOB,PSNXX))
- if 'PSNXX
- QUIT
- Begin DoDot:2
- +27 SET PSNIEN=+^TMP("DILIST",$JOB,PSNXX,0)
- +28 IF $ORDER(^PS(50.416,+PSNIEN,1,0))
- IF '$DATA(^PS(50.416,+PSNIEN,1,0))
- DO SETHDR^PSN50P4A
- +29 KILL ^TMP("PSNAPD",$JOB)
- DO GETS^DIQ(50.416,+PSNIEN,".01;1*","IE","^TMP(""PSNAPD"",$J)")
- SET PSN(1)=0
- +30 FOR
- SET PSN(1)=$ORDER(^TMP("PSNAPD",$JOB,50.416,PSN(1)))
- if 'PSN(1)
- QUIT
- Begin DoDot:3
- +31 SET ^TMP($JOB,LIST,+PSN(1),.01)=$GET(^TMP("PSNAPD",$JOB,50.416,PSN(1),.01,"I"))
- +32 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSNAPD",$JOB,50.416,PSN(1),.01,"I")),+PSN(1))=""
- +33 SET (CNT,PSN(2))=0
- FOR
- SET PSN(2)=$ORDER(^TMP("PSNAPD",$JOB,50.4161,PSN(2)))
- if 'PSN(2)
- QUIT
- Begin DoDot:4
- +34 SET ^TMP($JOB,LIST,+PSN(1),"ID",+PSN(2),.01)=$GET(^TMP("PSNAPD",$JOB,50.4161,PSN(2),.01,"I"))
- SET CNT=CNT+1
- End DoDot:4
- +35 SET ^TMP($JOB,LIST,+PSN(1),"ID",0)=$SELECT($GET(CNT)>0:CNT,1:"-1^NO DATA FOUND")
- End DoDot:3
- KILL PSN50P41
- End DoDot:2
- End DoDot:1
- +36 KILL ^TMP("DILIST",$JOB),^TMP("PSNAPD",$JOB)
- +37 QUIT
- +38 ;
- APS(PSNPI,LIST) ;
- +1 ;PSNPI - PRIMARY INGREDIENT field (#2) of the DRUG INGREDIENTS file (#50.416)
- +2 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
- +3 ; Field Number of the data piece being returned.
- +4 ;Returns DRUG IDENTIFIER field (#.01) of the DRUG IDENTIFIER multiple (#50.4161) of DRUG INGREDIENTS file (#50.416).
- +5 NEW DIERR,ZZERR,PSN50P41,PSN,CNT
- +6 IF $GET(LIST)']""
- QUIT
- +7 KILL ^TMP($JOB,LIST)
- +8 IF +$GET(PSNPI)'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +9 ;Naked reference below refers to ^PS(50.416,+Y,0)
- +10 SET SCR("S")="S ND=$G(^(0)) I $P(ND,""^"",2)=PSNPI"
- +11 IF +$GET(PSNPI)>0
- DO FIND^DIC(50.416,,"@;.01","QP",PSNPI,,"APS",SCR("S"),"")
- +12 IF +^TMP("DILIST",$JOB,0)'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +13 SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- +14 SET PSN(1)=0
- FOR
- SET PSN(1)=$ORDER(^TMP("DILIST",$JOB,PSN(1)))
- if 'PSN(1)
- QUIT
- Begin DoDot:1
- +15 SET PSNIEN=+^TMP("DILIST",$JOB,PSN(1),0)
- +16 IF $ORDER(^PS(50.416,+PSNIEN,1,0))
- IF '$DATA(^PS(50.416,+PSNIEN,1,0))
- DO SETHDR^PSN50P4A
- +17 KILL ^TMP("PSNAPS",$JOB)
- DO GETS^DIQ(50.416,+PSNIEN,".01;1*","IE","^TMP(""PSNAPS"",$J)")
- SET PSN(2)=0
- +18 FOR
- SET PSN(2)=$ORDER(^TMP("PSNAPS",$JOB,50.416,PSN(2)))
- if 'PSN(2)
- QUIT
- Begin DoDot:2
- +19 SET ^TMP($JOB,LIST,+PSN(2),.01)=$GET(^TMP("PSNAPS",$JOB,50.416,PSN(2),.01,"I"))
- +20 SET ^TMP($JOB,LIST,"APS",$GET(^TMP("PSNAPS",$JOB,50.416,PSN(2),.01,"I")),+PSN(2))=""
- +21 SET (CNT,PSN(3))=0
- FOR
- SET PSN(3)=$ORDER(^TMP("PSNAPS",$JOB,50.4161,PSN(3)))
- if 'PSN(3)
- QUIT
- Begin DoDot:3
- +22 SET ^TMP($JOB,LIST,+PSN(2),"ID",+PSN(3),.01)=$GET(^TMP("PSNAPS",$JOB,50.4161,PSN(3),.01,"I"))
- SET CNT=CNT+1
- +23 SET ^TMP($JOB,LIST,+PSN(2),"ID",0)=$SELECT($GET(CNT)>0:CNT,1:"-1^NO DATA FOUND")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 KILL ^TMP("DILIST",$JOB),^TMP("PSNAPS",$JOB)
- +25 QUIT
- +26 ;
- APD(PSNID,LIST) ;
- +1 ;PSNID - DRUG IDENTIFIER field (#.01) of the DRUG IDENTIFIER multiple of the DRUG INGREDIENTS file (#50.416)
- +2 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
- +3 ; Field Number of the data piece being returned.
- +4 ;Returns NAME field (#.01), PRIMARY INGREDIENTS field (#2), and DRUG IDENTIFIER field (#.01)
- +5 ;of the DRUG IDENTIFIER multiple (#50.4161) of DRUG INGREDIENTS file (#50.416).
- +6 NEW DIERR,ZZERR,PSN,CNT,CNT1
- +7 IF $GET(LIST)']""
- QUIT
- +8 KILL ^TMP($JOB,LIST),^TMP("PSNAPD",$JOB)
- +9 IF $GET(PSNID)']""
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +10 IF $LENGTH(PSNID)>30!($LENGTH(PSNID)<3)!'(PSNID?1.N1"A"1.N)
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +11 DO FIND^DIC(50.416,,"@;.01","QP",PSNID,,"APD",,,"")
- +12 IF +^TMP("DILIST",$JOB,0)'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +13 ;S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
- +14 SET (CNT1,PSN(1))=0
- FOR
- SET PSN(1)=$ORDER(^TMP("DILIST",$JOB,PSN(1)))
- if 'PSN(1)
- QUIT
- Begin DoDot:1
- +15 SET PSNIEN=+^TMP("DILIST",$JOB,PSN(1),0)
- +16 IF $ORDER(^PS(50.416,+PSNIEN,1,0))
- IF '$DATA(^PS(50.416,+PSNIEN,1,0))
- DO SETHDR^PSN50P4A
- +17 KILL ^TMP("PSNAPD",$JOB)
- DO GETS^DIQ(50.416,+PSNIEN,".01;2;1*","IE","^TMP(""PSNAPD"",$J)")
- Begin DoDot:2
- +18 if '$DATA(^PS(50.416,"APD",PSNID,+PSNIEN))
- QUIT
- +19 SET CNT1=CNT1+1
- +20 SET (CNT,PSN(2))=0
- FOR
- SET PSN(2)=$ORDER(^TMP("PSNAPD",$JOB,50.4161,PSN(2)))
- if 'PSN(2)
- QUIT
- Begin DoDot:3
- +21 SET ^TMP($JOB,LIST,+PSNIEN,"ID",+PSN(2),.01)=$GET(^TMP("PSNAPD",$JOB,50.4161,PSN(2),.01,"I"))
- SET CNT=CNT+1
- End DoDot:3
- +22 SET ^TMP($JOB,LIST,+PSNIEN,"ID",0)=$SELECT($GET(CNT)>0:CNT,1:"-1^NO DATA FOUND")
- +23 SET PSN(3)=0
- FOR
- SET PSN(3)=$ORDER(^TMP("PSNAPD",$JOB,50.416,PSN(3)))
- if 'PSN(3)
- QUIT
- Begin DoDot:3
- +24 SET ^TMP($JOB,LIST,+PSN(3),.01)=$GET(^TMP("PSNAPD",$JOB,50.416,PSN(3),.01,"I"))
- +25 SET ^TMP($JOB,LIST,"APD",$GET(^TMP("PSNAPD",$JOB,50.416,PSN(3),.01,"I")),+PSN(3))=""
- +26 SET ^TMP($JOB,LIST,+PSN(3),2)=$SELECT($GET(^TMP("PSNAPD",$JOB,50.416,PSN(3),2,"I"))="":"",1:^TMP("PSNAPD",$JOB,50.416,PSN(3),2,"I")_"^"_^TMP("PSNAPD",$JOB,50.416,PSN(3),2,"E"))
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +27 SET ^TMP($JOB,LIST,0)=$SELECT(CNT1>0:CNT1,1:"-1^NO DATA FOUND")
- +28 KILL ^TMP("DILIST",$JOB),^TMP("PSNAPD",$JOB)
- +29 QUIT