PSS50D ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85,105**;9/30/97
;
B ;
;PSSFT - Free Text name in 50
;PSSFL - Inactive flag - "" - All entries
; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
;PSSPK - Application Package's Use - "" - All entries
; Alphabetic codes that represent the DHCP packages that consider this drug to be
; part of their formulary.
;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
;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 list of drugs meeting input criteria
N DIERR,ZZERR,PSSP50,SCR,PSSIEN
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S SCR("S")=""
I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
I $G(PSSFT)]"" D
.I PSSFT["??" D LOOPB^PSS50C1 Q
.K ^TMP("DILIST",$J)
.D FIND^DIC(50,,"@;.01","QP",PSSFT,,"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 PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
..S PSSIEN=+$G(^TMP("DILIST",$J,PSSXX,0)) I PSSIEN,$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",2)'="" D
...S ^TMP($J,LIST,PSSIEN,.01)=$P(^TMP("DILIST",$J,PSSXX,0),"^",2)
...S ^TMP($J,LIST,"B",$P(^TMP("DILIST",$J,PSSXX,0),"^",2),PSSIEN)=""
K ^TMP("DILIST",$J)
Q
;
VAC ;
;PSSVAL - NATIONAL DRUG CLASS field (#25) of the DRUG file (#50)
;PSSFL - Inactive flag - "" - All entries
; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
;PSSPK - Application Package's Use - "" - All entries
; Alphabetic codes that represent the DHCP packages that consider this drug to be
; part of their formulary.
;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 list of drugs meeting input criteria
N DIERR,ZZERR,PSSP50,SCR,PSSIEN
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I ($G(PSSVAL)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S SCR("S")="I $P($G(^PSDRUG(+Y,""ND"")),""^"",6)=PSSVAL"
I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50C1
I $G(PSSVAL)]"" D
.K ^TMP("DILIST",$J)
.D FIND^DIC(50,,"@;.01","QP",PSSVAL,,"VAC",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 PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
..S PSSIEN=+$G(^TMP("DILIST",$J,PSSXX,0)) I PSSIEN,$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",2)'="" D
...S ^TMP($J,LIST,PSSIEN,.01)=$P(^TMP("DILIST",$J,PSSXX,0),"^",2)
...S ^TMP($J,LIST,"VAC",$P(^TMP("DILIST",$J,PSSXX,0),"^",2),PSSIEN)=""
K ^TMP("DILIST",$J)
Q
;
NDC ;
;PSSVAL - NDC field (#31) of the DRUG file (#50)
;PSSFL - Inactive flag - "" - All entries
; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
;PSSPK - Application Package's Use - "" - All entries
; Alphabetic codes that represent the DHCP packages that consider this drug to be
; part of their formulary.
;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 list of drugs meeting input criteria
;
; Must change to look directly at the NDC cross reference
N PSSNDC,PSSNDC1,PSSNDC2
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I ($G(PSSVAL)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S PSSNDC=0 F PSSNDC1=0:0 S PSSNDC1=$O(^PSDRUG("NDC",PSSVAL,PSSNDC1)) Q:'PSSNDC1 D
.S PSSNDC2=$P($G(^PSDRUG(PSSNDC1,0)),"^")
.I PSSNDC2="" Q
.I $G(PSSFL),$P($G(^PSDRUG(PSSNDC1,"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
.;Naked reference below refers to ^PSDRUG(PSSNDC1,"I"), or ^PSDRUG(PSSNDC1,0)
.I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5 I $P($G(^(2)),"^",3)[$E(PSSPK,PSSZ6) S PSSZ5=1
.I $G(PSSPK)]"",'PSSZ5 Q
.S ^TMP($J,LIST,PSSNDC1,.01)=PSSNDC2
.S ^TMP($J,LIST,"NDC",PSSNDC2,PSSNDC1)=""
.S PSSNDC=PSSNDC+1
S ^TMP($J,LIST,0)=$S($G(PSSNDC):$G(PSSNDC),1:"-1^NO DATA FOUND")
Q
;
ASP ;
;PSSVAL - PHARMACY ORDERABLE ITEM field (#2.1) of the DRUG file (#50)
;PSSFL - Inactive flag - "" - All entries
; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
;PSSPK - Application Package's Use - "" - All entries
; Alphabetic codes that represent the DHCP packages that consider this drug to be
; part of their formulary.
;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 list of drugs meeting input criteria
N DIERR,ZZERR,PSSP50,SCR,PSSIEN
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I ($G(PSSVAL)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S SCR("S")=""
I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
S SCR("S")=SCR("S")_" I +$G(^PSDRUG(+Y,2))=PSSVAL"
I $G(PSSVAL)]"" D
.D FIND^DIC(50,,"@;.01","QP",PSSVAL,,"ASP",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 XX S XX=0 F S XX=$O(^TMP("DILIST",$J,XX)) Q:'XX D
..S PSSIEN=+^TMP("DILIST",$J,XX,0),^TMP($J,LIST,PSSIEN,.01)=$P(^TMP("DILIST",$J,XX,0),"^",2)
..S ^TMP($J,LIST,"ASP",$P(^TMP("DILIST",$J,XX,0),"^",2),PSSIEN)=""
K ^TMP("DILIST",$J)
Q
;
AND ;
;PSSVAL -NATIONAL DRUG FILE ENTRY field (#20) of the DRUG file (#50)
;PSSFL - Inactive flag - "" - All entries
; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
;PSSPK - Application Package's Use - "" - All entries
; Alphabetic codes that represent the DHCP packages that consider this drug to be
; part of their formulary.
;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 list of drugs meeting input criteria
N DIERR,ZZERR,PSSP50,SCR,PSSIEN,CNT
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I ($G(PSSVAL)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S SCR("S")=""
I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
I $G(PSSVAL)]"" D
.S CNT=0
.D FIND^DIC(50,,"@;.01","QP",PSSVAL,,"AND",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 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS50 D GETS^DIQ(50,+PSSIEN,".01;20","IE","PSS50") S PSS(1)=0
..F S PSS(1)=$O(PSS50(50,PSS(1))) Q:'PSS(1) D
...Q:PSS50(50,PSS(1),20,"I")'=PSSVAL
...S ^TMP($J,LIST,PSSIEN,.01)=$G(PSS50(50,PSS(1),.01,"E")),CNT=CNT+1
...S ^TMP($J,LIST,"AND",$G(PSS50(50,PSS(1),.01,"E")),PSSIEN)=""
..S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
K ^TMP("DILIST",$J),PSS50
Q
;
AP ;
;PSSVAL - PRIMARY DRUG field (#64) of the DRUG file (#50)
;PSSFL - Inactive flag - "" - All entries
; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
;PSSPK - Application Package's Use - "" - All entries
; Alphabetic codes that represent the DHCP packages that consider this drug to be
; part of their formulary.
;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 list of drugs meeting input criteria
N DIERR,ZZERR,PSSP50,SCR,PSSIEN
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I ($G(PSSVAL)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S SCR("S")=""
I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
S SCR("S")=SCR("S")_" I +$P($G(^PSDRUG(+Y,2)),""^"",6)=PSSVAL"
I $G(PSSVAL)]"" D
.D FIND^DIC(50,,"@;.01","QP",PSSVAL,,"AP",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 XX S XX=0 F S XX=$O(^TMP("DILIST",$J,XX)) Q:'XX D
..S PSSIEN=+^TMP("DILIST",$J,XX,0),^TMP($J,LIST,PSSIEN,.01)=$P(^TMP("DILIST",$J,XX,0),"^",2)
..S ^TMP($J,LIST,"AP",$P(^TMP("DILIST",$J,XX,0),"^",2),PSSIEN)=""
K ^TMP("DILIST",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50D 9216 printed Nov 22, 2024@17:39:51 Page 2
PSS50D ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85,105**;9/30/97
+2 ;
B ;
+1 ;PSSFT - Free Text name in 50
+2 ;PSSFL - Inactive flag - "" - All entries
+3 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
+4 ;PSSPK - Application Package's Use - "" - All entries
+5 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
+6 ; part of their formulary.
+7 ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
+8 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
+9 ; piece being returned.
+10 ;Returns list of drugs meeting input criteria
+11 NEW DIERR,ZZERR,PSSP50,SCR,PSSIEN
+12 IF $GET(LIST)']""
QUIT
+13 KILL ^TMP($JOB,LIST)
+14 IF $GET(PSSFT)']""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+15 SET SCR("S")=""
+16 IF +$GET(PSSFL)>0!($GET(PSSPK)]"")!($GET(PSSRTOI)=1)
NEW PSS5ND,PSSZ3,PSSZ4
DO SETSCRN^PSS50A
+17 IF $GET(PSSFT)]""
Begin DoDot:1
+18 IF PSSFT["??"
DO LOOPB^PSS50C1
QUIT
+19 KILL ^TMP("DILIST",$JOB)
+20 DO FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
+21 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+22 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:2
+23 SET PSSIEN=+$GET(^TMP("DILIST",$JOB,PSSXX,0))
IF PSSIEN
IF $PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",2)'=""
Begin DoDot:3
+24 SET ^TMP($JOB,LIST,PSSIEN,.01)=$PIECE(^TMP("DILIST",$JOB,PSSXX,0),"^",2)
+25 SET ^TMP($JOB,LIST,"B",$PIECE(^TMP("DILIST",$JOB,PSSXX,0),"^",2),PSSIEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+26 KILL ^TMP("DILIST",$JOB)
+27 QUIT
+28 ;
VAC ;
+1 ;PSSVAL - NATIONAL DRUG CLASS field (#25) of the DRUG file (#50)
+2 ;PSSFL - Inactive flag - "" - All entries
+3 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
+4 ;PSSPK - Application Package's Use - "" - All entries
+5 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
+6 ; part of their formulary.
+7 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
+8 ; piece being returned.
+9 ;Returns list of drugs meeting input criteria
+10 NEW DIERR,ZZERR,PSSP50,SCR,PSSIEN
+11 IF $GET(LIST)']""
QUIT
+12 KILL ^TMP($JOB,LIST)
+13 IF ($GET(PSSVAL)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+14 SET SCR("S")="I $P($G(^PSDRUG(+Y,""ND"")),""^"",6)=PSSVAL"
+15 IF +$GET(PSSFL)>0!($GET(PSSPK)]"")
NEW PSS5ND,PSSZ3,PSSZ4
DO SETSCRN^PSS50C1
+16 IF $GET(PSSVAL)]""
Begin DoDot:1
+17 KILL ^TMP("DILIST",$JOB)
+18 DO FIND^DIC(50,,"@;.01","QP",PSSVAL,,"VAC",SCR("S"),,"")
+19 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+20 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:2
+21 SET PSSIEN=+$GET(^TMP("DILIST",$JOB,PSSXX,0))
IF PSSIEN
IF $PIECE($GET(^TMP("DILIST",$JOB,PSSXX,0)),"^",2)'=""
Begin DoDot:3
+22 SET ^TMP($JOB,LIST,PSSIEN,.01)=$PIECE(^TMP("DILIST",$JOB,PSSXX,0),"^",2)
+23 SET ^TMP($JOB,LIST,"VAC",$PIECE(^TMP("DILIST",$JOB,PSSXX,0),"^",2),PSSIEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+24 KILL ^TMP("DILIST",$JOB)
+25 QUIT
+26 ;
NDC ;
+1 ;PSSVAL - NDC field (#31) of the DRUG file (#50)
+2 ;PSSFL - Inactive flag - "" - All entries
+3 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
+4 ;PSSPK - Application Package's Use - "" - All entries
+5 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
+6 ; part of their formulary.
+7 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
+8 ; piece being returned.
+9 ;Returns list of drugs meeting input criteria
+10 ;
+11 ; Must change to look directly at the NDC cross reference
+12 NEW PSSNDC,PSSNDC1,PSSNDC2
+13 IF $GET(LIST)']""
QUIT
+14 KILL ^TMP($JOB,LIST)
+15 IF ($GET(PSSVAL)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+16 SET PSSNDC=0
FOR PSSNDC1=0:0
SET PSSNDC1=$ORDER(^PSDRUG("NDC",PSSVAL,PSSNDC1))
if 'PSSNDC1
QUIT
Begin DoDot:1
+17 SET PSSNDC2=$PIECE($GET(^PSDRUG(PSSNDC1,0)),"^")
+18 IF PSSNDC2=""
QUIT
+19 IF $GET(PSSFL)
IF $PIECE($GET(^PSDRUG(PSSNDC1,"I")),"^")
IF $PIECE($GET(^("I")),"^")'>PSSFL
QUIT
+20 ;Naked reference below refers to ^PSDRUG(PSSNDC1,"I"), or ^PSDRUG(PSSNDC1,0)
+21 IF $GET(PSSPK)]""
NEW PSSZ5,PSSZ6
SET PSSZ5=0
FOR PSSZ6=1:1:$LENGTH(PSSPK)
if PSSZ5
QUIT
IF $PIECE($GET(^(2)),"^",3)[$EXTRACT(PSSPK,PSSZ6)
SET PSSZ5=1
+22 IF $GET(PSSPK)]""
IF 'PSSZ5
QUIT
+23 SET ^TMP($JOB,LIST,PSSNDC1,.01)=PSSNDC2
+24 SET ^TMP($JOB,LIST,"NDC",PSSNDC2,PSSNDC1)=""
+25 SET PSSNDC=PSSNDC+1
End DoDot:1
+26 SET ^TMP($JOB,LIST,0)=$SELECT($GET(PSSNDC):$GET(PSSNDC),1:"-1^NO DATA FOUND")
+27 QUIT
+28 ;
ASP ;
+1 ;PSSVAL - PHARMACY ORDERABLE ITEM field (#2.1) of the DRUG file (#50)
+2 ;PSSFL - Inactive flag - "" - All entries
+3 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
+4 ;PSSPK - Application Package's Use - "" - All entries
+5 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
+6 ; part of their formulary.
+7 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
+8 ; piece being returned.
+9 ;Returns list of drugs meeting input criteria
+10 NEW DIERR,ZZERR,PSSP50,SCR,PSSIEN
+11 IF $GET(LIST)']""
QUIT
+12 KILL ^TMP($JOB,LIST)
+13 IF ($GET(PSSVAL)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+14 SET SCR("S")=""
+15 IF +$GET(PSSFL)>0!($GET(PSSPK)]"")
NEW PSS5ND,PSSZ3,PSSZ4
DO SETSCRN^PSS50A
+16 SET SCR("S")=SCR("S")_" I +$G(^PSDRUG(+Y,2))=PSSVAL"
+17 IF $GET(PSSVAL)]""
Begin DoDot:1
+18 DO FIND^DIC(50,,"@;.01","QP",PSSVAL,,"ASP",SCR("S"),,"")
+19 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+20 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW XX
SET XX=0
FOR
SET XX=$ORDER(^TMP("DILIST",$JOB,XX))
if 'XX
QUIT
Begin DoDot:2
+21 SET PSSIEN=+^TMP("DILIST",$JOB,XX,0)
SET ^TMP($JOB,LIST,PSSIEN,.01)=$PIECE(^TMP("DILIST",$JOB,XX,0),"^",2)
+22 SET ^TMP($JOB,LIST,"ASP",$PIECE(^TMP("DILIST",$JOB,XX,0),"^",2),PSSIEN)=""
End DoDot:2
End DoDot:1
+23 KILL ^TMP("DILIST",$JOB)
+24 QUIT
+25 ;
AND ;
+1 ;PSSVAL -NATIONAL DRUG FILE ENTRY field (#20) of the DRUG file (#50)
+2 ;PSSFL - Inactive flag - "" - All entries
+3 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
+4 ;PSSPK - Application Package's Use - "" - All entries
+5 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
+6 ; part of their formulary.
+7 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
+8 ; piece being returned.
+9 ;Returns list of drugs meeting input criteria
+10 NEW DIERR,ZZERR,PSSP50,SCR,PSSIEN,CNT
+11 IF $GET(LIST)']""
QUIT
+12 KILL ^TMP($JOB,LIST)
+13 IF ($GET(PSSVAL)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+14 SET SCR("S")=""
+15 IF +$GET(PSSFL)>0!($GET(PSSPK)]"")
NEW PSS5ND,PSSZ3,PSSZ4
DO SETSCRN^PSS50A
+16 IF $GET(PSSVAL)]""
Begin DoDot:1
+17 SET CNT=0
+18 DO FIND^DIC(50,,"@;.01","QP",PSSVAL,,"AND",SCR("S"),,"")
+19 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+20 IF +^TMP("DILIST",$JOB,0)>0
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:2
+21 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS50
DO GETS^DIQ(50,+PSSIEN,".01;20","IE","PSS50")
SET PSS(1)=0
+22 FOR
SET PSS(1)=$ORDER(PSS50(50,PSS(1)))
if 'PSS(1)
QUIT
Begin DoDot:3
+23 if PSS50(50,PSS(1),20,"I")'=PSSVAL
QUIT
+24 SET ^TMP($JOB,LIST,PSSIEN,.01)=$GET(PSS50(50,PSS(1),.01,"E"))
SET CNT=CNT+1
+25 SET ^TMP($JOB,LIST,"AND",$GET(PSS50(50,PSS(1),.01,"E")),PSSIEN)=""
End DoDot:3
+26 SET ^TMP($JOB,LIST,0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
End DoDot:2
End DoDot:1
+27 KILL ^TMP("DILIST",$JOB),PSS50
+28 QUIT
+29 ;
AP ;
+1 ;PSSVAL - PRIMARY DRUG field (#64) of the DRUG file (#50)
+2 ;PSSFL - Inactive flag - "" - All entries
+3 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
+4 ;PSSPK - Application Package's Use - "" - All entries
+5 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
+6 ; part of their formulary.
+7 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
+8 ; piece being returned.
+9 ;Returns list of drugs meeting input criteria
+10 NEW DIERR,ZZERR,PSSP50,SCR,PSSIEN
+11 IF $GET(LIST)']""
QUIT
+12 KILL ^TMP($JOB,LIST)
+13 IF ($GET(PSSVAL)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+14 SET SCR("S")=""
+15 IF +$GET(PSSFL)>0!($GET(PSSPK)]"")
NEW PSS5ND,PSSZ3,PSSZ4
DO SETSCRN^PSS50A
+16 SET SCR("S")=SCR("S")_" I +$P($G(^PSDRUG(+Y,2)),""^"",6)=PSSVAL"
+17 IF $GET(PSSVAL)]""
Begin DoDot:1
+18 DO FIND^DIC(50,,"@;.01","QP",PSSVAL,,"AP",SCR("S"),,"")
+19 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+20 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW XX
SET XX=0
FOR
SET XX=$ORDER(^TMP("DILIST",$JOB,XX))
if 'XX
QUIT
Begin DoDot:2
+21 SET PSSIEN=+^TMP("DILIST",$JOB,XX,0)
SET ^TMP($JOB,LIST,PSSIEN,.01)=$PIECE(^TMP("DILIST",$JOB,XX,0),"^",2)
+22 SET ^TMP($JOB,LIST,"AP",$PIECE(^TMP("DILIST",$JOB,XX,0),"^",2),PSSIEN)=""
End DoDot:2
End DoDot:1
+23 KILL ^TMP("DILIST",$JOB)
+24 QUIT
