- PSN5067 ;BIR/LDT - API FOR INFORMATION FROM FILE 50.67; 5 Sep 03
- ;;4.0; NATIONAL DRUG FILE;**109**; 30 Oct 98
- ;
- ALL(PSNIEN,PSNFT,PSNFL,LIST) ;
- ;PSNIEN - IEN of entry in NDC/UPN file (#50.67).
- ;PSNFT - Free Text TRADE NAME in NDC/UPN file (#50.67).
- ;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 SEQUENCE NUMBER field (#.01), NDC field (#1), UPN field (#2), MANUFACTURER field (#3), TRADE NAME field (#4),
- ;VA PRODUCT NAME field (#5), INACTIVATION DATE field (#7), PACKAGE SIZE field (#8), PACKAGE TYPE field (#9), and
- ;OTX/RX INDICATOR field (#10) of the NDC/UPN file (#50.67).
- N DIERR,ZZERR,PSN5067,PSN,SCR
- 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 N ND D SETSCRN
- I $G(PSNIEN)]"" N PSNIEN2 S PSNIEN2=$$FIND1^DIC(50.67,"","B","`"_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.67,+PSNIEN2,".01:10","IE","PSN5067") S PSN(1)=0
- .F S PSN(1)=$O(PSN5067(50.67,PSN(1))) Q:'PSN(1) D SETZRO
- I $G(PSNIEN)="",$G(PSNFT)]"" D
- .I PSNFT["??" D LOOP Q
- .D FIND^DIC(50.67,,"@;.01;1","QP",PSNFT,,"T",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 PSN5067 D GETS^DIQ(50.67,+PSNIEN,".01:10","IE","PSN5067") S PSN(1)=0
- ..F S PSN(1)=$O(PSN5067(50.67,PSN(1))) Q:'PSN(1) D SETZRO
- K ^TMP("DILIST",$J)
- Q
- ;
- SETZRO ;
- S ^TMP($J,LIST,+PSN(1),.01)=$G(PSN5067(50.67,PSN(1),.01,"I"))
- S ^TMP($J,LIST,+PSN(1),1)=$G(PSN5067(50.67,PSN(1),1,"I"))
- S ^TMP($J,LIST,+PSN(1),2)=$G(PSN5067(50.67,PSN(1),2,"I"))
- 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"))
- S ^TMP($J,LIST,+PSN(1),4)=$G(PSN5067(50.67,PSN(1),4,"I"))
- I $G(PSN5067(50.67,PSN(1),4,"I"))'="" S ^TMP($J,LIST,"B",$G(PSN5067(50.67,PSN(1),4,"I")),+PSN(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"))
- 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"))
- 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"))
- 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"))
- 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"))
- Q
- ;
- LOOP ;
- N PSN567D,PSN567E,PSN567RX,PSN567ND,PSNVAL
- D FIELD^DID(50.67,10,"Z","POINTER","PSN567D","PSN567E") S PSN567RX=$G(PSN567D("POINTER"))
- N PSNENCT
- S PSNENCT=0
- S PSNVAL=0 F S PSNVAL=$O(^PSNDF(50.67,PSNVAL)) Q:'PSNVAL D
- .I $P($G(^PSNDF(50.67,PSNVAL,0)),"^")="" Q
- .I $G(PSNFL),$P($G(^PSNDF(50.67,PSNVAL,0)),"^",7),$P($G(^(0)),"^",7)'>PSNFL Q
- .S PSN567ND=$G(^PSNDF(50.67,PSNVAL,0))
- .S ^TMP($J,LIST,+PSNVAL,.01)=$P(PSN567ND,"^")
- .I $P(PSN567ND,"^",5)'="" S ^TMP($J,LIST,"B",$P(PSN567ND,"^",5),+PSNVAL)=""
- .S ^TMP($J,LIST,+PSNVAL,1)=$P(PSN567ND,"^",2)
- .S ^TMP($J,LIST,+PSNVAL,2)=$P(PSN567ND,"^",3)
- .S ^TMP($J,LIST,+PSNVAL,3)=$S($P(PSN567ND,"^",4):$P(PSN567ND,"^",4)_"^"_$P($G(^PS(55.95,+$P(PSN567ND,"^",4),0)),"^"),1:"")
- .S ^TMP($J,LIST,+PSNVAL,4)=$P(PSN567ND,"^",5)
- .S ^TMP($J,LIST,+PSNVAL,5)=$S($P(PSN567ND,"^",6):$P(PSN567ND,"^",6)_"^"_$P($G(^PSNDF(50.68,+$P(PSN567ND,"^",6),0)),"^"),1:"")
- .N Y S Y=$P(PSN567ND,"^",7) D
- ..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
- ..S ^TMP($J,LIST,+PSNVAL,7)=""
- .S ^TMP($J,LIST,+PSNVAL,8)=$S($P(PSN567ND,"^",8):$P(PSN567ND,"^",8)_"^"_$P($G(^PS(50.609,+$P(PSN567ND,"^",8),0)),"^"),1:"")
- .S ^TMP($J,LIST,+PSNVAL,9)=$S($P(PSN567ND,"^",9):$P(PSN567ND,"^",9)_"^"_$P($G(^PS(50.608,+$P(PSN567ND,"^",9),0)),"^"),1:"")
- .N PSN567NR S PSN567NR=$P(PSN567ND,"^",10) D
- ..I PSN567NR'="",PSN567RX'="",PSN567RX[(PSN567NR_":") S ^TMP($J,LIST,+PSNVAL,10)=PSN567NR_"^"_$P($E(PSN567RX,$F(PSN567RX,(PSN567NR_":")),999),";") Q
- ..S ^TMP($J,LIST,+PSNVAL,10)=""
- .S PSNENCT=PSNENCT+1
- S ^TMP($J,LIST,0)=$S($G(PSNENCT):$G(PSNENCT),1:"-1^NO DATA FOUND")
- Q
- ;
- SETSCRN ;
- S SCR("S")="S ND=$P($G(^PSNDF(50.67,+Y,0)),""^"",7) I ND=""""!(ND>PSNFL)"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN5067 4905 printed Jan 18, 2025@03:23:32 Page 2
- PSN5067 ;BIR/LDT - API FOR INFORMATION FROM FILE 50.67; 5 Sep 03
- +1 ;;4.0; NATIONAL DRUG FILE;**109**; 30 Oct 98
- +2 ;
- ALL(PSNIEN,PSNFT,PSNFL,LIST) ;
- +1 ;PSNIEN - IEN of entry in NDC/UPN file (#50.67).
- +2 ;PSNFT - Free Text TRADE NAME in NDC/UPN file (#50.67).
- +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
- +6 ; Field Number is the Field Number of the data piece being returned.
- +7 ;Returns SEQUENCE NUMBER field (#.01), NDC field (#1), UPN field (#2), MANUFACTURER field (#3), TRADE NAME field (#4),
- +8 ;VA PRODUCT NAME field (#5), INACTIVATION DATE field (#7), PACKAGE SIZE field (#8), PACKAGE TYPE field (#9), and
- +9 ;OTX/RX INDICATOR field (#10) of the NDC/UPN file (#50.67).
- +10 NEW DIERR,ZZERR,PSN5067,PSN,SCR
- +11 IF $GET(LIST)']""
- QUIT
- +12 KILL ^TMP($JOB,LIST)
- +13 IF $GET(PSNIEN)']""
- IF ($GET(PSNFT)']"")
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +14 IF $GET(PSNIEN)]""
- IF (+$GET(PSNIEN)'>0)
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +15 SET SCR("S")=""
- +16 IF +$GET(PSNFL)>0
- NEW ND
- DO SETSCRN
- +17 IF $GET(PSNIEN)]""
- NEW PSNIEN2
- SET PSNIEN2=$$FIND1^DIC(50.67,"","B","`"_PSNIEN,,SCR("S"),"")
- Begin DoDot:1
- +18 IF +PSNIEN2'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +19 SET ^TMP($JOB,LIST,0)=1
- +20 DO GETS^DIQ(50.67,+PSNIEN2,".01:10","IE","PSN5067")
- SET PSN(1)=0
- +21 FOR
- SET PSN(1)=$ORDER(PSN5067(50.67,PSN(1)))
- if 'PSN(1)
- QUIT
- DO SETZRO
- End DoDot:1
- +22 IF $GET(PSNIEN)=""
- IF $GET(PSNFT)]""
- Begin DoDot:1
- +23 IF PSNFT["??"
- DO LOOP
- QUIT
- +24 DO FIND^DIC(50.67,,"@;.01;1","QP",PSNFT,,"T",SCR("S"),,"")
- +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)
- KILL PSN5067
- DO GETS^DIQ(50.67,+PSNIEN,".01:10","IE","PSN5067")
- SET PSN(1)=0
- +28 FOR
- SET PSN(1)=$ORDER(PSN5067(50.67,PSN(1)))
- if 'PSN(1)
- QUIT
- DO SETZRO
- End DoDot:2
- End DoDot:1
- +29 KILL ^TMP("DILIST",$JOB)
- +30 QUIT
- +31 ;
- SETZRO ;
- +1 SET ^TMP($JOB,LIST,+PSN(1),.01)=$GET(PSN5067(50.67,PSN(1),.01,"I"))
- +2 SET ^TMP($JOB,LIST,+PSN(1),1)=$GET(PSN5067(50.67,PSN(1),1,"I"))
- +3 SET ^TMP($JOB,LIST,+PSN(1),2)=$GET(PSN5067(50.67,PSN(1),2,"I"))
- +4 SET ^TMP($JOB,LIST,+PSN(1),3)=$SELECT($GET(PSN5067(50.67,PSN(1),3,"I"))="":"",1:PSN5067(50.67,PSN(1),3,"I")_"^"_PSN5067(50.67,PSN(1),3,"E"))
- +5 SET ^TMP($JOB,LIST,+PSN(1),4)=$GET(PSN5067(50.67,PSN(1),4,"I"))
- +6 IF $GET(PSN5067(50.67,PSN(1),4,"I"))'=""
- SET ^TMP($JOB,LIST,"B",$GET(PSN5067(50.67,PSN(1),4,"I")),+PSN(1))=""
- +7 SET ^TMP($JOB,LIST,+PSN(1),5)=$SELECT($GET(PSN5067(50.67,PSN(1),5,"I"))="":"",1:PSN5067(50.67,PSN(1),5,"I")_"^"_PSN5067(50.67,PSN(1),5,"E"))
- +8 SET ^TMP($JOB,LIST,+PSN(1),7)=$SELECT($GET(PSN5067(50.67,PSN(1),7,"I"))="":"",1:PSN5067(50.67,PSN(1),7,"I")_"^"_PSN5067(50.67,PSN(1),7,"E"))
- +9 SET ^TMP($JOB,LIST,+PSN(1),8)=$SELECT($GET(PSN5067(50.67,PSN(1),8,"I"))="":"",1:PSN5067(50.67,PSN(1),8,"I")_"^"_PSN5067(50.67,PSN(1),8,"E"))
- +10 SET ^TMP($JOB,LIST,+PSN(1),9)=$SELECT($GET(PSN5067(50.67,PSN(1),9,"I"))="":"",1:PSN5067(50.67,PSN(1),9,"I")_"^"_PSN5067(50.67,PSN(1),9,"E"))
- +11 SET ^TMP($JOB,LIST,+PSN(1),10)=$SELECT($GET(PSN5067(50.67,PSN(1),10,"I"))="":"",1:PSN5067(50.67,PSN(1),10,"I")_"^"_PSN5067(50.67,PSN(1),10,"E"))
- +12 QUIT
- +13 ;
- LOOP ;
- +1 NEW PSN567D,PSN567E,PSN567RX,PSN567ND,PSNVAL
- +2 DO FIELD^DID(50.67,10,"Z","POINTER","PSN567D","PSN567E")
- SET PSN567RX=$GET(PSN567D("POINTER"))
- +3 NEW PSNENCT
- +4 SET PSNENCT=0
- +5 SET PSNVAL=0
- FOR
- SET PSNVAL=$ORDER(^PSNDF(50.67,PSNVAL))
- if 'PSNVAL
- QUIT
- Begin DoDot:1
- +6 IF $PIECE($GET(^PSNDF(50.67,PSNVAL,0)),"^")=""
- QUIT
- +7 IF $GET(PSNFL)
- IF $PIECE($GET(^PSNDF(50.67,PSNVAL,0)),"^",7)
- IF $PIECE($GET(^(0)),"^",7)'>PSNFL
- QUIT
- +8 SET PSN567ND=$GET(^PSNDF(50.67,PSNVAL,0))
- +9 SET ^TMP($JOB,LIST,+PSNVAL,.01)=$PIECE(PSN567ND,"^")
- +10 IF $PIECE(PSN567ND,"^",5)'=""
- SET ^TMP($JOB,LIST,"B",$PIECE(PSN567ND,"^",5),+PSNVAL)=""
- +11 SET ^TMP($JOB,LIST,+PSNVAL,1)=$PIECE(PSN567ND,"^",2)
- +12 SET ^TMP($JOB,LIST,+PSNVAL,2)=$PIECE(PSN567ND,"^",3)
- +13 SET ^TMP($JOB,LIST,+PSNVAL,3)=$SELECT($PIECE(PSN567ND,"^",4):$PIECE(PSN567ND,"^",4)_"^"_$PIECE($GET(^PS(55.95,+$PIECE(PSN567ND,"^",4),0)),"^"),1:"")
- +14 SET ^TMP($JOB,LIST,+PSNVAL,4)=$PIECE(PSN567ND,"^",5)
- +15 SET ^TMP($JOB,LIST,+PSNVAL,5)=$SELECT($PIECE(PSN567ND,"^",6):$PIECE(PSN567ND,"^",6)_"^"_$PIECE($GET(^PSNDF(50.68,+$PIECE(PSN567ND,"^",6),0)),"^"),1:"")
- +16 NEW Y
- SET Y=$PIECE(PSN567ND,"^",7)
- Begin DoDot:2
- +17 IF Y
- SET ^TMP($JOB,LIST,+PSNVAL,7)=$GET(Y)
- XECUTE ^DD("DD")
- SET ^TMP($JOB,LIST,+PSNVAL,7)=^TMP($JOB,LIST,+PSNVAL,7)_"^"_$GET(Y)
- QUIT
- +18 SET ^TMP($JOB,LIST,+PSNVAL,7)=""
- End DoDot:2
- +19 SET ^TMP($JOB,LIST,+PSNVAL,8)=$SELECT($PIECE(PSN567ND,"^",8):$PIECE(PSN567ND,"^",8)_"^"_$PIECE($GET(^PS(50.609,+$PIECE(PSN567ND,"^",8),0)),"^"),1:"")
- +20 SET ^TMP($JOB,LIST,+PSNVAL,9)=$SELECT($PIECE(PSN567ND,"^",9):$PIECE(PSN567ND,"^",9)_"^"_$PIECE($GET(^PS(50.608,+$PIECE(PSN567ND,"^",9),0)),"^"),1:"")
- +21 NEW PSN567NR
- SET PSN567NR=$PIECE(PSN567ND,"^",10)
- Begin DoDot:2
- +22 IF PSN567NR'=""
- IF PSN567RX'=""
- IF PSN567RX[(PSN567NR_":")
- SET ^TMP($JOB,LIST,+PSNVAL,10)=PSN567NR_"^"_$PIECE($EXTRACT(PSN567RX,$FIND(PSN567RX,(PSN567NR_":")),999),";")
- QUIT
- +23 SET ^TMP($JOB,LIST,+PSNVAL,10)=""
- End DoDot:2
- +24 SET PSNENCT=PSNENCT+1
- End DoDot:1
- +25 SET ^TMP($JOB,LIST,0)=$SELECT($GET(PSNENCT):$GET(PSNENCT),1:"-1^NO DATA FOUND")
- +26 QUIT
- +27 ;
- SETSCRN ;
- +1 SET SCR("S")="S ND=$P($G(^PSNDF(50.67,+Y,0)),""^"",7) I ND=""""!(ND>PSNFL)"
- +2 QUIT