- 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
- 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
