- 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 Jan 18, 2025@03:23:41 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