PSN50P68 ;BIR/LDT-API FOR INFORMATION FROM FILE 50.68 ; 5 Sep 03
;;4.0;NATIONAL DRUG FILE;**80,94,104,109,396**; 30 Oct 98;Build 190
;
FORM(PSNIEN) ;
;PSNIEN - IEN of entry in VA PRODUCT file (#50.68).
;Returns NATIONAL FORMULARY NAME field (#4) of the VA PRODUCT file (#50.68).
I +$G(PSNIEN)'>0 Q ""
Q $P($G(^PSNDF(50.68,+PSNIEN,0)),"^",6)
;
DATA(PSNIEN,PSNFT,LIST) ;
;PSNIEN - IEN of entry in VA PRODUCT file (#50.68).
;PSNFT - Free Text name in VA PRODUCT file (#50.68).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
; Field Number of the data piece beingreturned.
N DIERR,ZZERR,PSN50P68,PSN,PSNSERVP
S PSNSERVP=$$PATCH^XPDUTL("PSN*4.0*103")
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)]"" N PSNIEN2 S PSNIEN2=$$FIND1^DIC(50.68,"","B","`"_PSNIEN,,,"") D
.I +PSNIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(50.68,+PSNIEN2,".01;.05;3;4;5;6;8;11;12;13;19;2000;101;102;103;104;105;108*","IE","PSN50P68") S PSN(1)=0
.F S PSN(1)=$O(PSN50P68(50.68,PSN(1))) Q:'PSN(1) D SETZRO
.S PSN(1)=0 F S PSN(1)=$O(PSN50P68(50.68108,PSN(1))) Q:'PSN(1) D CLEFF
I $G(PSNIEN)="",$G(PSNFT)]"" D
.I PSNFT["??" D LOOP Q
.D FIND^DIC(50.68,,"@;.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) K PSN50P68 D GETS^DIQ(50.68,+PSNIEN,".01;.05;3;4;5;6;8;11;12;13;19;2000;101;102;103;104;105;108*","IE","PSN50P68") S PSN(1)=0
..F S PSN(1)=$O(PSN50P68(50.68,PSN(1))) Q:'PSN(1) D SETZRO
K ^TMP("DILIST",$J)
Q
SETZRO ;
S ^TMP($J,LIST,+PSN(1),.01)=$G(PSN50P68(50.68,PSN(1),.01,"I"))
S ^TMP($J,LIST,"B",$G(PSN50P68(50.68,PSN(1),.01,"I")),+PSN(1))=""
S ^TMP($J,LIST,+PSN(1),.05)=$S($G(PSN50P68(50.68,PSN(1),.05,"I"))="":"",1:$G(PSN50P68(50.68,PSN(1),.05,"I"))_"^"_$G(PSN50P68(50.68,PSN(1),.05,"E")))
S ^TMP($J,LIST,+PSN(1),3)=$S($G(PSN50P68(50.68,PSN(1),3,"I"))="":"",1:$G(PSN50P68(50.68,PSN(1),3,"I"))_"^"_$G(PSN50P68(50.68,PSN(1),3,"E")))
S ^TMP($J,LIST,+PSN(1),4)=$G(PSN50P68(50.68,PSN(1),4,"I"))
S ^TMP($J,LIST,+PSN(1),5)=$G(PSN50P68(50.68,PSN(1),5,"I"))
S ^TMP($J,LIST,+PSN(1),6)=$G(PSN50P68(50.68,PSN(1),6,"I"))
S ^TMP($J,LIST,+PSN(1),8)=$G(PSN50P68(50.68,PSN(1),8,"I"))
S ^TMP($J,LIST,+PSN(1),11)=$G(PSN50P68(50.68,PSN(1),11,"I"))
S ^TMP($J,LIST,+PSN(1),12)=$G(PSN50P68(50.68,PSN(1),12,"I"))
S ^TMP($J,LIST,+PSN(1),13)=$G(PSN50P68(50.68,PSN(1),13,"I"))
S ^TMP($J,LIST,+PSN(1),19)=$S($G(PSN50P68(50.68,PSN(1),19,"I"))="":"",1:$G(PSN50P68(50.68,PSN(1),19,"I"))_"^"_$G(PSN50P68(50.68,PSN(1),19,"E")))
I $G(PSNSERVP) S ^TMP($J,LIST,+PSN(1),2000)=$S($G(PSN50P68(50.68,PSN(1),2000,"I"))'="":$G(PSN50P68(50.68,PSN(1),2000,"I")),1:600000)
S ^TMP($J,LIST,+PSN(1),101)=$G(PSN50P68(50.68,PSN(1),101,"I"))
S ^TMP($J,LIST,+PSN(1),102)=$G(PSN50P68(50.68,PSN(1),102,"I"))
S ^TMP($J,LIST,+PSN(1),103)=$G(PSN50P68(50.68,PSN(1),103,"I"))
S ^TMP($J,LIST,+PSN(1),104)=$G(PSN50P68(50.68,PSN(1),104,"I"))
;S ^TMP($J,LIST,+PSN(1),105)=$G(PSN50P68(50.68,PSN(1),105,"I"))
N PSNHAZWC,X S PSNHAZWC=0
F S PSNHAZWC=$O(PSN50P68(50.68,PSN(1),105,PSNHAZWC)) Q:'PSNHAZWC D
.S X="",X=PSN50P68(50.68,PSN(1),105,PSNHAZWC) S ^TMP($J,LIST,+PSN(1),105,PSNHAZWC)=X
Q
;
CLEFF ;set clinical effects of drug
S ^TMP($J,LIST,$P(PSN(1),",",2),108,$P(PSN(1),","),.01)=$G(PSN50P68(50.68108,PSN(1),.01,"I"))
S ^TMP($J,LIST,$P(PSN(1),",",2),108,$P(PSN(1),","),1)=$G(PSN50P68(50.68108,PSN(1),1,"I"))
S ^TMP($J,LIST,$P(PSN(1),",",2),108,$P(PSN(1),","),2)=$G(PSN50P68(50.68108,PSN(1),2,"I"))
Q
;
LOOP ;
N PSNIEN,CNT,PSN50DD1,PSN50DD2,PSN50DD3,PSN1NOD,PSNZNOD,PSN1NOD,PSN7FED
D FIELD^DID(50.68,19,"Z","POINTER","PSN50DD1","PSN50DD2") S PSN50DD3=$G(PSN50DD1("POINTER"))
S CNT=0
S PSNIEN=0 F S PSNIEN=$O(^PSNDF(50.68,PSNIEN)) Q:'PSNIEN D
.S PSNZNOD=$G(^PSNDF(50.68,PSNIEN,0)),PSN1NOD=$G(^(1)),PSN7FED=$P($G(^(7)),"^")
.I $P(PSNZNOD,"^")="" Q
.S CNT=CNT+1
.S ^TMP($J,LIST,PSNIEN,.01)=$P(PSNZNOD,"^")
.S ^TMP($J,LIST,"B",$P(PSNZNOD,"^"),PSNIEN)=""
.S ^TMP($J,LIST,PSNIEN,.05)=$S($P(PSNZNOD,"^",2)="":"",1:$P(PSNZNOD,"^",2)_"^"_$P($G(^PSNDF(50.6,+$P(PSNZNOD,"^",2),0)),"^"))
.S ^TMP($J,LIST,PSNIEN,3)=$S($P(PSNZNOD,"^",5)="":"",1:$P(PSNZNOD,"^",5)_"^"_$P($G(^PS(50.607,+$P(PSNZNOD,"^",5),0)),"^"))
.S ^TMP($J,LIST,PSNIEN,4)=$P(PSNZNOD,"^",6)
.S ^TMP($J,LIST,PSNIEN,11)=$P(PSN1NOD,"^",5)
.S ^TMP($J,LIST,PSNIEN,12)=$P(PSN1NOD,"^",6)
.S ^TMP($J,LIST,PSNIEN,13)=$P(PSN1NOD,"^",7)
.I PSN50DD3'="",PSN7FED'="",PSN50DD3[(PSN7FED_":") S ^TMP($J,LIST,PSNIEN,19)=PSN7FED_"^"_$P($E(PSN50DD3,$F(PSN50DD3,(PSN7FED_":")),999),";")
.I '$D(^TMP($J,LIST,PSNIEN,19)) S ^TMP($J,LIST,PSNIEN,19)=""
.I $G(PSNSERVP) S ^TMP($J,LIST,PSNIEN,2000)=$S($P($G(^PSNDF(50.68,PSNIEN,"PFS")),"^")'="":$P($G(^PSNDF(50.68,PSNIEN,"PFS")),"^"),1:600000)
.S ^TMP($J,LIST,PSNIEN,101)=$P(PSN1NOD,"^",5)
S ^TMP($J,LIST,0)=$S(+CNT>0:CNT,1:"-1^NO DATA FOUND")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN50P68 5279 printed Oct 16, 2024@18:23:23 Page 2
PSN50P68 ;BIR/LDT-API FOR INFORMATION FROM FILE 50.68 ; 5 Sep 03
+1 ;;4.0;NATIONAL DRUG FILE;**80,94,104,109,396**; 30 Oct 98;Build 190
+2 ;
FORM(PSNIEN) ;
+1 ;PSNIEN - IEN of entry in VA PRODUCT file (#50.68).
+2 ;Returns NATIONAL FORMULARY NAME field (#4) of the VA PRODUCT file (#50.68).
+3 IF +$GET(PSNIEN)'>0
QUIT ""
+4 QUIT $PIECE($GET(^PSNDF(50.68,+PSNIEN,0)),"^",6)
+5 ;
DATA(PSNIEN,PSNFT,LIST) ;
+1 ;PSNIEN - IEN of entry in VA PRODUCT file (#50.68).
+2 ;PSNFT - Free Text name in VA PRODUCT file (#50.68).
+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 beingreturned.
+5 NEW DIERR,ZZERR,PSN50P68,PSN,PSNSERVP
+6 SET PSNSERVP=$$PATCH^XPDUTL("PSN*4.0*103")
+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)]""
NEW PSNIEN2
SET PSNIEN2=$$FIND1^DIC(50.68,"","B","`"_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 DO GETS^DIQ(50.68,+PSNIEN2,".01;.05;3;4;5;6;8;11;12;13;19;2000;101;102;103;104;105;108*","IE","PSN50P68")
SET PSN(1)=0
+15 FOR
SET PSN(1)=$ORDER(PSN50P68(50.68,PSN(1)))
if 'PSN(1)
QUIT
DO SETZRO
+16 SET PSN(1)=0
FOR
SET PSN(1)=$ORDER(PSN50P68(50.68108,PSN(1)))
if 'PSN(1)
QUIT
DO CLEFF
End DoDot:1
+17 IF $GET(PSNIEN)=""
IF $GET(PSNFT)]""
Begin DoDot:1
+18 IF PSNFT["??"
DO LOOP
QUIT
+19 DO FIND^DIC(50.68,,"@;.01","QP",PSNFT,,"B",,,"")
+20 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+21 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
+22 SET PSNIEN=+^TMP("DILIST",$JOB,PSNXX,0)
KILL PSN50P68
DO GETS^DIQ(50.68,+PSNIEN,".01;.05;3;4;5;6;8;11;12;13;19;2000;101;102;103;104;105;108*","IE","PSN50P68")
SET PSN(1)=0
+23 FOR
SET PSN(1)=$ORDER(PSN50P68(50.68,PSN(1)))
if 'PSN(1)
QUIT
DO SETZRO
End DoDot:2
End DoDot:1
+24 KILL ^TMP("DILIST",$JOB)
+25 QUIT
SETZRO ;
+1 SET ^TMP($JOB,LIST,+PSN(1),.01)=$GET(PSN50P68(50.68,PSN(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,"B",$GET(PSN50P68(50.68,PSN(1),.01,"I")),+PSN(1))=""
+3 SET ^TMP($JOB,LIST,+PSN(1),.05)=$SELECT($GET(PSN50P68(50.68,PSN(1),.05,"I"))="":"",1:$GET(PSN50P68(50.68,PSN(1),.05,"I"))_"^"_$GET(PSN50P68(50.68,PSN(1),.05,"E")))
+4 SET ^TMP($JOB,LIST,+PSN(1),3)=$SELECT($GET(PSN50P68(50.68,PSN(1),3,"I"))="":"",1:$GET(PSN50P68(50.68,PSN(1),3,"I"))_"^"_$GET(PSN50P68(50.68,PSN(1),3,"E")))
+5 SET ^TMP($JOB,LIST,+PSN(1),4)=$GET(PSN50P68(50.68,PSN(1),4,"I"))
+6 SET ^TMP($JOB,LIST,+PSN(1),5)=$GET(PSN50P68(50.68,PSN(1),5,"I"))
+7 SET ^TMP($JOB,LIST,+PSN(1),6)=$GET(PSN50P68(50.68,PSN(1),6,"I"))
+8 SET ^TMP($JOB,LIST,+PSN(1),8)=$GET(PSN50P68(50.68,PSN(1),8,"I"))
+9 SET ^TMP($JOB,LIST,+PSN(1),11)=$GET(PSN50P68(50.68,PSN(1),11,"I"))
+10 SET ^TMP($JOB,LIST,+PSN(1),12)=$GET(PSN50P68(50.68,PSN(1),12,"I"))
+11 SET ^TMP($JOB,LIST,+PSN(1),13)=$GET(PSN50P68(50.68,PSN(1),13,"I"))
+12 SET ^TMP($JOB,LIST,+PSN(1),19)=$SELECT($GET(PSN50P68(50.68,PSN(1),19,"I"))="":"",1:$GET(PSN50P68(50.68,PSN(1),19,"I"))_"^"_$GET(PSN50P68(50.68,PSN(1),19,"E")))
+13 IF $GET(PSNSERVP)
SET ^TMP($JOB,LIST,+PSN(1),2000)=$SELECT($GET(PSN50P68(50.68,PSN(1),2000,"I"))'="":$GET(PSN50P68(50.68,PSN(1),2000,"I")),1:600000)
+14 SET ^TMP($JOB,LIST,+PSN(1),101)=$GET(PSN50P68(50.68,PSN(1),101,"I"))
+15 SET ^TMP($JOB,LIST,+PSN(1),102)=$GET(PSN50P68(50.68,PSN(1),102,"I"))
+16 SET ^TMP($JOB,LIST,+PSN(1),103)=$GET(PSN50P68(50.68,PSN(1),103,"I"))
+17 SET ^TMP($JOB,LIST,+PSN(1),104)=$GET(PSN50P68(50.68,PSN(1),104,"I"))
+18 ;S ^TMP($J,LIST,+PSN(1),105)=$G(PSN50P68(50.68,PSN(1),105,"I"))
+19 NEW PSNHAZWC,X
SET PSNHAZWC=0
+20 FOR
SET PSNHAZWC=$ORDER(PSN50P68(50.68,PSN(1),105,PSNHAZWC))
if 'PSNHAZWC
QUIT
Begin DoDot:1
+21 SET X=""
SET X=PSN50P68(50.68,PSN(1),105,PSNHAZWC)
SET ^TMP($JOB,LIST,+PSN(1),105,PSNHAZWC)=X
End DoDot:1
+22 QUIT
+23 ;
CLEFF ;set clinical effects of drug
+1 SET ^TMP($JOB,LIST,$PIECE(PSN(1),",",2),108,$PIECE(PSN(1),","),.01)=$GET(PSN50P68(50.68108,PSN(1),.01,"I"))
+2 SET ^TMP($JOB,LIST,$PIECE(PSN(1),",",2),108,$PIECE(PSN(1),","),1)=$GET(PSN50P68(50.68108,PSN(1),1,"I"))
+3 SET ^TMP($JOB,LIST,$PIECE(PSN(1),",",2),108,$PIECE(PSN(1),","),2)=$GET(PSN50P68(50.68108,PSN(1),2,"I"))
+4 QUIT
+5 ;
LOOP ;
+1 NEW PSNIEN,CNT,PSN50DD1,PSN50DD2,PSN50DD3,PSN1NOD,PSNZNOD,PSN1NOD,PSN7FED
+2 DO FIELD^DID(50.68,19,"Z","POINTER","PSN50DD1","PSN50DD2")
SET PSN50DD3=$GET(PSN50DD1("POINTER"))
+3 SET CNT=0
+4 SET PSNIEN=0
FOR
SET PSNIEN=$ORDER(^PSNDF(50.68,PSNIEN))
if 'PSNIEN
QUIT
Begin DoDot:1
+5 SET PSNZNOD=$GET(^PSNDF(50.68,PSNIEN,0))
SET PSN1NOD=$GET(^(1))
SET PSN7FED=$PIECE($GET(^(7)),"^")
+6 IF $PIECE(PSNZNOD,"^")=""
QUIT
+7 SET CNT=CNT+1
+8 SET ^TMP($JOB,LIST,PSNIEN,.01)=$PIECE(PSNZNOD,"^")
+9 SET ^TMP($JOB,LIST,"B",$PIECE(PSNZNOD,"^"),PSNIEN)=""
+10 SET ^TMP($JOB,LIST,PSNIEN,.05)=$SELECT($PIECE(PSNZNOD,"^",2)="":"",1:$PIECE(PSNZNOD,"^",2)_"^"_$PIECE($GET(^PSNDF(50.6,+$PIECE(PSNZNOD,"^",2),0)),"^"))
+11 SET ^TMP($JOB,LIST,PSNIEN,3)=$SELECT($PIECE(PSNZNOD,"^",5)="":"",1:$PIECE(PSNZNOD,"^",5)_"^"_$PIECE($GET(^PS(50.607,+$PIECE(PSNZNOD,"^",5),0)),"^"))
+12 SET ^TMP($JOB,LIST,PSNIEN,4)=$PIECE(PSNZNOD,"^",6)
+13 SET ^TMP($JOB,LIST,PSNIEN,11)=$PIECE(PSN1NOD,"^",5)
+14 SET ^TMP($JOB,LIST,PSNIEN,12)=$PIECE(PSN1NOD,"^",6)
+15 SET ^TMP($JOB,LIST,PSNIEN,13)=$PIECE(PSN1NOD,"^",7)
+16 IF PSN50DD3'=""
IF PSN7FED'=""
IF PSN50DD3[(PSN7FED_":")
SET ^TMP($JOB,LIST,PSNIEN,19)=PSN7FED_"^"_$PIECE($EXTRACT(PSN50DD3,$FIND(PSN50DD3,(PSN7FED_":")),999),";")
+17 IF '$DATA(^TMP($JOB,LIST,PSNIEN,19))
SET ^TMP($JOB,LIST,PSNIEN,19)=""
+18 IF $GET(PSNSERVP)
SET ^TMP($JOB,LIST,PSNIEN,2000)=$SELECT($PIECE($GET(^PSNDF(50.68,PSNIEN,"PFS")),"^")'="":$PIECE($GET(^PSNDF(50.68,PSNIEN,"PFS")),"^"),1:600000)
+19 SET ^TMP($JOB,LIST,PSNIEN,101)=$PIECE(PSN1NOD,"^",5)
End DoDot:1
+20 SET ^TMP($JOB,LIST,0)=$SELECT(+CNT>0:CNT,1:"-1^NO DATA FOUND")
+21 QUIT
