PSS50P7 ;BIR/LDT - API FOR INFORMATION FROM FILE 50.7;Aug 24, 2021@15:03:03
;;1.0;PHARMACY DATA MANAGEMENT;**85,91,199,234,187**;9/30/97;Build 27
;
;
ZERO(PSSIEN,PSSFT,PSSFL,LIST) ;
;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
;PSSFT - Free Text name in PHARMACY ORDERABLE ITEM file (#50.7).
;PSSFL - 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 NAME field (#.01), DOSAGE FORM field (#.02), IV FLAG field (#.03), INACTIVE DATE field (#.04),
;DAY (nD) OR DOSE (nL) LIMIT field (#.05), MED ROUTE field (#.06), SCHEDULE TYPE fiedl (#.07),
;SCHEDULE field (#.08), SUPPLY field (#.09), FORMULARY STATUS field (#5), and NON-VA MED field (#8) of
;PHARMACY ORDERABLE ITEM file (#50.7).
N DIERR,ZZERR,PSS50P7,SCR,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S SCR("S")=""
I +$G(PSSFL)>0 N ND D SETSCRN
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50.7,"","A","`"_PSSIEN,,SCR("S"),"") D
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(50.7,+PSSIEN2,".01;.02;.03;.04;.05;.06;.07;.08;.09;8;5","IE","PSS50P7") S PSS(1)=0
.F S PSS(1)=$O(PSS50P7(50.7,PSS(1))) Q:'PSS(1) D SETZRO^PSS50P7A
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP^PSS50P7A(1) Q
.D FIND^DIC(50.7,,"@;.01;.02","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=+^TMP("DILIST",$J,PSSXX,0) K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02;.03;.04;.05;.06;.07;.08;.09;8;5","IE","PSS50P7") S PSS(1)=0
..F S PSS(1)=$O(PSS50P7(50.7,PSS(1))) Q:'PSS(1) D SETZRO^PSS50P7A
K ^TMP("DILIST",$J)
Q
;
SYNONYM(PSSIEN,PSSFT,PSSFL,LIST) ;
;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
;PSSFT - Free Text name in PHARMACY ORDERABLE ITEM file (#50.7).
;PSSFL - Inactive flag - 0 or "" - 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 NAME field (#.01), DOSAGE FORM field (#.02), SYNONYM subfile (#50.72), and SYNONYM field (#.01)
;of PHARMACY ORDERABLE ITEM file (#50.7).
N DIERR,ZZERR,PSS50P7,SCR,PSS,CNT
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S SCR("S")=""
I +$G(PSSFL)>0 N ND D SETSCRN
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50.7,"","A","`"_PSSIEN,,SCR("S"),"") D
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(50.7,+PSSIEN2,".01;.02;2*","IE","PSS50P7") S PSS(1)=0
.S CNT=0 F S PSS(1)=$O(PSS50P7(50.72,PSS(1))) Q:'PSS(1) D SETSYN^PSS50P7A S CNT=CNT+1
.S ^TMP($J,LIST,+PSSIEN2,"SYN",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
.S PSS(2)=0 F S PSS(2)=$O(PSS50P7(50.7,PSS(2))) Q:'PSS(2) D SETZR2^PSS50P7A
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP^PSS50P7A(2) Q
.D FIND^DIC(50.7,,"@;.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=+^TMP("DILIST",$J,PSSXX,0) K PSS50P7(50.72) K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02;2*","IE","PSS50P7") S PSS(1)=0
..S CNT=0 F S PSS(1)=$O(PSS50P7(50.72,PSS(1))) Q:'PSS(1) D SETSYN^PSS50P7A S CNT=CNT+1
..S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
..S PSS(2)=0 F S PSS(2)=$O(PSS50P7(50.7,PSS(2))) Q:'PSS(2) D SETZR2^PSS50P7A
K ^TMP("DILIST",$J)
Q
;
NAME(PSSIEN) ;
;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
;Returns NAME field (#.01) of PHARMACY ORDERABLE ITEM file (#50.7) and DOSAGE FORM name in external form.
N DIERR,ZZERR,PSS50P7,PSS
I +$G(PSSIEN)'>0 Q ""
D GETS^DIQ(50.7,+PSSIEN,".01;.02","E","PSS50P7")
I '$D(PSS50P7) Q ""
Q $G(PSS50P7(50.7,PSSIEN_",",.01,"E"))_" "_$G(PSS50P7(50.7,PSSIEN_",",.02,"E"))
;
INSTR(PSSIEN,PSSFT,PSSFL,LIST) ;
;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
;PSSFT - Free Text name in PHARMACY ORDERABLE ITEM file (#50.7).
;PSSFL - 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 INS and INS1 nodes of PHARMACY ORDERABLE ITEM file (#50.7).
N DIERR,ZZERR,PSS50P7,SCR,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S SCR("S")=""
I +$G(PSSFL)>0 N ND D SETSCRN
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50.7,"","A","`"_PSSIEN,,SCR("S"),"") D
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(50.7,+PSSIEN2,".01;.02;7;7.1","IE","PSS50P7") S PSS(1)=0
.F S PSS(1)=$O(PSS50P7(50.7,PSS(1))) Q:'PSS(1) D SETPTI^PSS50P7A
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP^PSS50P7A(3) Q
.D FIND^DIC(50.7,,"@;.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=+^TMP("DILIST",$J,PSSXX,0) K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02;7;7.1","IE","PSS50P7") S PSS(1)=0
..F S PSS(1)=$O(PSS50P7(50.7,PSS(1))) Q:'PSS(1) D SETPTI^PSS50P7A
K ^TMP("DILIST",$J)
Q
;
DRGIEN(PSSIEN,PSSFL,LIST) ;
;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
;PSSFL - 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 entries from DRUG file (#50) linked to the Pharmacy Orderable Item IEN passed, GENERIC NAME field (#.01),
;DEA, SPECIAL HDLG field (#3), APPLICATION PACKAGES' USE field (#63), and the INACTIVE DATE field (#100)
;of DRUG file (#50).
N DIERR,ZZERR,PSS50P7,SCR,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S SCR("S")="I $D(^PS(50.7,""A50"",PSSIEN,Y))"
;Naked reference below refers to ^PSDRUG(Y,"I")
I +$G(PSSFL)>0 S SCR("S")="S ND=$G(^(""I"")) I ((ND="""")&($D(^PS(50.7,""A50"",PSSIEN,Y))))!((ND>PSSFL)&($D(^PS(50.7,""A50"",PSSIEN,Y))))"
I +$G(PSSIEN)>0 D FIND^DIC(50,,"@;.01","QX",PSSIEN,,"ASP",SCR("S"),,"PSS50P7")
I +PSS50P7("DILIST",0)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S ^TMP($J,LIST,0)=+PSS50P7("DILIST",0) S PSS(1)=0 D
.F S PSS(1)=$O(PSS50P7("DILIST",PSS(1))) Q:'PSS(1) S PSS(2)=0 F S PSS(2)=$O(PSS50P7("DILIST",PSS(1),PSS(2))) Q:'PSS(2) S ^TMP($J,LIST,+PSS50P7("DILIST",PSS(1),PSS(2)))=""
Q
;
IEN(PSSFT,PSSFL,LIST) ;
;PSSFT - Free Text name in PHARMACY ORDERABLE ITEM file (#50.7).
;PSSFL - 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 NAME field (#.01), and DOSAGE FORM field (#.02) of PHARMACY ORDERABLE ITEM file (#50.7).
N DIERR,ZZERR,PSS50P7,SCR,PSS
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 D SETSCRN
I PSSFT["??" D LOOP^PSS50P7A(4) Q
I $G(PSSFT)]"" D FIND^DIC(50.7,,"@;.01;.02IE","QP",PSSFT,,"B",SCR("S"),,"")
I +$G(^TMP("DILIST",$J,0))'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) S PSS(2)=0 D
.F S PSS(2)=$O(^TMP("DILIST",$J,PSS(2))) Q:'PSS(2) D
..S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.01)=$P(^TMP("DILIST",$J,PSS(2),0),"^",2)
..S ^TMP($J,LIST,"B",$P(^TMP("DILIST",$J,PSS(2),0),"^",2),+^TMP("DILIST",$J,PSS(2),0))=""
..S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.02)=$S($P($G(^TMP("DILIST",$J,PSS(2),0)),"^",3)]"":$P(^TMP("DILIST",$J,PSS(2),0),"^",3,4),1:"")
K ^TMP("DILIST",$J)
Q
;
LOOKUP(PSSFT,PSSD,PSSS,LIST) ;
;PSSFT - Free Text name in PHARMACY ORDERABLE ITEM file (#50.7)
;PSSD - Index being traversed.
;PSSS - Screening information as defined in DIC("S").
;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 NAME field (#.01), DOSAGE FORM field (#.02), and INACTIVE DATE field (#.04) of
;PHARMACY ORDERABLE ITEM file (#50.7).
N DIERR,ZZERR,PSS50P7,SCR,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
D LOOKUP^PSS50P7A
Q
;
SETSCRN ;Set Screen for inactive entries in PHARMACY ORDERABLE ITEM file (#50.7).
;Naked reference below refers to ^PS(50.7,+Y,0)
S SCR("S")="S ND=$P($G(^(0)),U,4) I ND=""""!(ND>PSSFL)"
Q
SSET(PSSC,PSSCNT,PSSI,DIR,SUB) ;Pull back a subset of the PHARMACY ORDERABLE ITEM file (#50.7)
;
N PSSJ,PS0,Y,PSSIDT
F Q:PSSC'<PSSCNT S PSSI=$O(^PS(50.7,"B",PSSI),DIR) Q:PSSI="" S PSSJ=0 F S PSSJ=$O(^PS(50.7,"B",PSSI,PSSJ)) Q:'PSSJ I $D(^PS(50.7,PSSJ,0)) S PS0=^(0) D
. S Y=$P(PS0,"^",4) D DD^%DT S PSSIDT=Y
. S Y=$P($G(^PS(50.606,$P(PS0,"^",2),0)),"^"),PSSC=PSSC+1,^TMP(SUB,$J,1,PSSC)=PSSJ_"^"_PSSI_" "_Y_" "_PSSIDT
Q
INDCATN(PSSIEN,LIST) ; *187 return Indications for Use for Prescription and Medication Order
N I,J,K,IND,ARR
I +$G(PSSIEN)'>0!($G(LIST)']"") Q
K ^TMP($J,LIST) S I="",K=0
I $P($G(^PS(50.7,PSSIEN,4)),"^",2)]"" S K=1,IND=$$ENLU^PSSGMI($P(^PS(50.7,PSSIEN,4),"^",2)),^TMP($J,LIST,1)=IND_"^"_K,ARR(IND)="" ;if most common indication exists, return its value
F S I=$O(^PS(50.7,PSSIEN,"IND","B",I)) Q:I="" D
.S IND=$$ENLU^PSSGMI(I) ;convert to uppercase
.I '$D(ARR(IND)) S ARR(IND)=""
S I="" F S I=$O(ARR(I)) Q:I="" I $P($G(^TMP($J,LIST,1)),"^")'=I S K=K+1,^TMP($J,LIST,K)=I
S I="",K=0 K ARR
I $P($G(^PS(50.7,PSSIEN,4)),"^",4)]"" S K=1,IND=$$ENLU^PSSGMI($P(^PS(50.7,PSSIEN,4),"^",4)),^TMP($J,LIST,"OTH",1)=IND_"^"_K,ARR(IND)="" ;if other most common indication exists, return its value
F S I=$O(^PS(50.7,PSSIEN,"INDO","B",I)) Q:I="" D
.S IND=$$ENLU^PSSGMI(I) ;convert to uppercase
.I '$D(ARR(IND)) S ARR(IND)=""
S I="" F S I=$O(ARR(I)) Q:I="" I $P($G(^TMP($J,LIST,"OTH",1)),"^")'=I S K=K+1,^TMP($J,LIST,"OTH",K)=I
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50P7 11389 printed Oct 16, 2024@18:30:42 Page 2
PSS50P7 ;BIR/LDT - API FOR INFORMATION FROM FILE 50.7;Aug 24, 2021@15:03:03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,199,234,187**;9/30/97;Build 27
+2 ;
+3 ;
ZERO(PSSIEN,PSSFT,PSSFL,LIST) ;
+1 ;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
+2 ;PSSFT - Free Text name in PHARMACY ORDERABLE ITEM file (#50.7).
+3 ;PSSFL - 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 Field Number is the
+6 ;Field Number of the data piece being returned.
+7 ;Returns NAME field (#.01), DOSAGE FORM field (#.02), IV FLAG field (#.03), INACTIVE DATE field (#.04),
+8 ;DAY (nD) OR DOSE (nL) LIMIT field (#.05), MED ROUTE field (#.06), SCHEDULE TYPE fiedl (#.07),
+9 ;SCHEDULE field (#.08), SUPPLY field (#.09), FORMULARY STATUS field (#5), and NON-VA MED field (#8) of
+10 ;PHARMACY ORDERABLE ITEM file (#50.7).
+11 NEW DIERR,ZZERR,PSS50P7,SCR,PSS
+12 IF $GET(LIST)']""
QUIT
+13 KILL ^TMP($JOB,LIST)
+14 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+15 IF $GET(PSSIEN)]""
IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+16 SET SCR("S")=""
+17 IF +$GET(PSSFL)>0
NEW ND
DO SETSCRN
+18 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(50.7,"","A","`"_PSSIEN,,SCR("S"),"")
Begin DoDot:1
+19 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+20 SET ^TMP($JOB,LIST,0)=1
+21 DO GETS^DIQ(50.7,+PSSIEN2,".01;.02;.03;.04;.05;.06;.07;.08;.09;8;5","IE","PSS50P7")
SET PSS(1)=0
+22 FOR
SET PSS(1)=$ORDER(PSS50P7(50.7,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO^PSS50P7A
End DoDot:1
+23 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+24 IF PSSFT["??"
DO LOOP^PSS50P7A(1)
QUIT
+25 DO FIND^DIC(50.7,,"@;.01;.02","QP",PSSFT,,"B",SCR("S"),,"")
+26 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+27 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
+28 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS50P7
DO GETS^DIQ(50.7,+PSSIEN,".01;.02;.03;.04;.05;.06;.07;.08;.09;8;5","IE","PSS50P7")
SET PSS(1)=0
+29 FOR
SET PSS(1)=$ORDER(PSS50P7(50.7,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO^PSS50P7A
End DoDot:2
End DoDot:1
+30 KILL ^TMP("DILIST",$JOB)
+31 QUIT
+32 ;
SYNONYM(PSSIEN,PSSFT,PSSFL,LIST) ;
+1 ;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
+2 ;PSSFT - Free Text name in PHARMACY ORDERABLE ITEM file (#50.7).
+3 ;PSSFL - Inactive flag - 0 or "" - 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 Field Number is the
+6 ;Field Number of the data piece being returned.
+7 ;Returns NAME field (#.01), DOSAGE FORM field (#.02), SYNONYM subfile (#50.72), and SYNONYM field (#.01)
+8 ;of PHARMACY ORDERABLE ITEM file (#50.7).
+9 NEW DIERR,ZZERR,PSS50P7,SCR,PSS,CNT
+10 IF $GET(LIST)']""
QUIT
+11 KILL ^TMP($JOB,LIST)
+12 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+13 IF $GET(PSSIEN)]""
IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+14 SET SCR("S")=""
+15 IF +$GET(PSSFL)>0
NEW ND
DO SETSCRN
+16 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(50.7,"","A","`"_PSSIEN,,SCR("S"),"")
Begin DoDot:1
+17 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+18 SET ^TMP($JOB,LIST,0)=1
+19 DO GETS^DIQ(50.7,+PSSIEN2,".01;.02;2*","IE","PSS50P7")
SET PSS(1)=0
+20 SET CNT=0
FOR
SET PSS(1)=$ORDER(PSS50P7(50.72,PSS(1)))
if 'PSS(1)
QUIT
DO SETSYN^PSS50P7A
SET CNT=CNT+1
+21 SET ^TMP($JOB,LIST,+PSSIEN2,"SYN",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
+22 SET PSS(2)=0
FOR
SET PSS(2)=$ORDER(PSS50P7(50.7,PSS(2)))
if 'PSS(2)
QUIT
DO SETZR2^PSS50P7A
End DoDot:1
+23 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+24 IF PSSFT["??"
DO LOOP^PSS50P7A(2)
QUIT
+25 DO FIND^DIC(50.7,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
+26 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+27 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
+28 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS50P7(50.72)
KILL PSS50P7
DO GETS^DIQ(50.7,+PSSIEN,".01;.02;2*","IE","PSS50P7")
SET PSS(1)=0
+29 SET CNT=0
FOR
SET PSS(1)=$ORDER(PSS50P7(50.72,PSS(1)))
if 'PSS(1)
QUIT
DO SETSYN^PSS50P7A
SET CNT=CNT+1
+30 SET ^TMP($JOB,LIST,+PSSIEN,"SYN",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
+31 SET PSS(2)=0
FOR
SET PSS(2)=$ORDER(PSS50P7(50.7,PSS(2)))
if 'PSS(2)
QUIT
DO SETZR2^PSS50P7A
End DoDot:2
End DoDot:1
+32 KILL ^TMP("DILIST",$JOB)
+33 QUIT
+34 ;
NAME(PSSIEN) ;
+1 ;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
+2 ;Returns NAME field (#.01) of PHARMACY ORDERABLE ITEM file (#50.7) and DOSAGE FORM name in external form.
+3 NEW DIERR,ZZERR,PSS50P7,PSS
+4 IF +$GET(PSSIEN)'>0
QUIT ""
+5 DO GETS^DIQ(50.7,+PSSIEN,".01;.02","E","PSS50P7")
+6 IF '$DATA(PSS50P7)
QUIT ""
+7 QUIT $GET(PSS50P7(50.7,PSSIEN_",",.01,"E"))_" "_$GET(PSS50P7(50.7,PSSIEN_",",.02,"E"))
+8 ;
INSTR(PSSIEN,PSSFT,PSSFL,LIST) ;
+1 ;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
+2 ;PSSFT - Free Text name in PHARMACY ORDERABLE ITEM file (#50.7).
+3 ;PSSFL - 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 Field Number is the
+6 ;Field Number of the data piece being returned.
+7 ;Returns INS and INS1 nodes of PHARMACY ORDERABLE ITEM file (#50.7).
+8 NEW DIERR,ZZERR,PSS50P7,SCR,PSS
+9 IF $GET(LIST)']""
QUIT
+10 KILL ^TMP($JOB,LIST)
+11 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+12 IF $GET(PSSIEN)]""
IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+13 SET SCR("S")=""
+14 IF +$GET(PSSFL)>0
NEW ND
DO SETSCRN
+15 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(50.7,"","A","`"_PSSIEN,,SCR("S"),"")
Begin DoDot:1
+16 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+17 SET ^TMP($JOB,LIST,0)=1
+18 DO GETS^DIQ(50.7,+PSSIEN2,".01;.02;7;7.1","IE","PSS50P7")
SET PSS(1)=0
+19 FOR
SET PSS(1)=$ORDER(PSS50P7(50.7,PSS(1)))
if 'PSS(1)
QUIT
DO SETPTI^PSS50P7A
End DoDot:1
+20 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+21 IF PSSFT["??"
DO LOOP^PSS50P7A(3)
QUIT
+22 DO FIND^DIC(50.7,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
+23 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+24 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
+25 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS50P7
DO GETS^DIQ(50.7,+PSSIEN,".01;.02;7;7.1","IE","PSS50P7")
SET PSS(1)=0
+26 FOR
SET PSS(1)=$ORDER(PSS50P7(50.7,PSS(1)))
if 'PSS(1)
QUIT
DO SETPTI^PSS50P7A
End DoDot:2
End DoDot:1
+27 KILL ^TMP("DILIST",$JOB)
+28 QUIT
+29 ;
DRGIEN(PSSIEN,PSSFL,LIST) ;
+1 ;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
+2 ;PSSFL - Inactive flag - "" - All entries.
+3 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
+4 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+5 ;Field Number of the data piece being returned.
+6 ;Returns entries from DRUG file (#50) linked to the Pharmacy Orderable Item IEN passed, GENERIC NAME field (#.01),
+7 ;DEA, SPECIAL HDLG field (#3), APPLICATION PACKAGES' USE field (#63), and the INACTIVE DATE field (#100)
+8 ;of DRUG file (#50).
+9 NEW DIERR,ZZERR,PSS50P7,SCR,PSS
+10 IF $GET(LIST)']""
QUIT
+11 KILL ^TMP($JOB,LIST)
+12 IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+13 SET SCR("S")="I $D(^PS(50.7,""A50"",PSSIEN,Y))"
+14 ;Naked reference below refers to ^PSDRUG(Y,"I")
+15 IF +$GET(PSSFL)>0
SET SCR("S")="S ND=$G(^(""I"")) I ((ND="""")&($D(^PS(50.7,""A50"",PSSIEN,Y))))!((ND>PSSFL)&($D(^PS(50.7,""A50"",PSSIEN,Y))))"
+16 IF +$GET(PSSIEN)>0
DO FIND^DIC(50,,"@;.01","QX",PSSIEN,,"ASP",SCR("S"),,"PSS50P7")
+17 IF +PSS50P7("DILIST",0)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+18 SET ^TMP($JOB,LIST,0)=+PSS50P7("DILIST",0)
SET PSS(1)=0
Begin DoDot:1
+19 FOR
SET PSS(1)=$ORDER(PSS50P7("DILIST",PSS(1)))
if 'PSS(1)
QUIT
SET PSS(2)=0
FOR
SET PSS(2)=$ORDER(PSS50P7("DILIST",PSS(1),PSS(2)))
if 'PSS(2)
QUIT
SET ^TMP($JOB,LIST,+PSS50P7("DILIST",PSS(1),PSS(2)))=""
End DoDot:1
+20 QUIT
+21 ;
IEN(PSSFT,PSSFL,LIST) ;
+1 ;PSSFT - Free Text name in PHARMACY ORDERABLE ITEM file (#50.7).
+2 ;PSSFL - Inactive flag - "" - All entries.
+3 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
+4 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+5 ;Field Number of the data piece being returned.
+6 ;Returns NAME field (#.01), and DOSAGE FORM field (#.02) of PHARMACY ORDERABLE ITEM file (#50.7).
+7 NEW DIERR,ZZERR,PSS50P7,SCR,PSS
+8 IF $GET(LIST)']""
QUIT
+9 KILL ^TMP($JOB,LIST)
+10 IF $GET(PSSFT)']""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+11 SET SCR("S")=""
+12 IF +$GET(PSSFL)>0
DO SETSCRN
+13 IF PSSFT["??"
DO LOOP^PSS50P7A(4)
QUIT
+14 IF $GET(PSSFT)]""
DO FIND^DIC(50.7,,"@;.01;.02IE","QP",PSSFT,,"B",SCR("S"),,"")
+15 IF +$GET(^TMP("DILIST",$JOB,0))'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+16 SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
SET PSS(2)=0
Begin DoDot:1
+17 FOR
SET PSS(2)=$ORDER(^TMP("DILIST",$JOB,PSS(2)))
if 'PSS(2)
QUIT
Begin DoDot:2
+18 SET ^TMP($JOB,LIST,+^TMP("DILIST",$JOB,PSS(2),0),.01)=$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",2)
+19 SET ^TMP($JOB,LIST,"B",$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",2),+^TMP("DILIST",$JOB,PSS(2),0))=""
+20 SET ^TMP($JOB,LIST,+^TMP("DILIST",$JOB,PSS(2),0),.02)=$SELECT($PIECE($GET(^TMP("DILIST",$JOB,PSS(2),0)),"^",3)]"":$PIECE(^TMP("DILIST",$JOB,PSS(2),0),"^",3,4),1:"")
End DoDot:2
End DoDot:1
+21 KILL ^TMP("DILIST",$JOB)
+22 QUIT
+23 ;
LOOKUP(PSSFT,PSSD,PSSS,LIST) ;
+1 ;PSSFT - Free Text name in PHARMACY ORDERABLE ITEM file (#50.7)
+2 ;PSSD - Index being traversed.
+3 ;PSSS - Screening information as defined in DIC("S").
+4 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+5 ;Field Number of the data piece being returned.
+6 ;Returns NAME field (#.01), DOSAGE FORM field (#.02), and INACTIVE DATE field (#.04) of
+7 ;PHARMACY ORDERABLE ITEM file (#50.7).
+8 NEW DIERR,ZZERR,PSS50P7,SCR,PSS
+9 IF $GET(LIST)']""
QUIT
+10 KILL ^TMP($JOB,LIST)
+11 IF $GET(PSSFT)']""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+12 DO LOOKUP^PSS50P7A
+13 QUIT
+14 ;
SETSCRN ;Set Screen for inactive entries in PHARMACY ORDERABLE ITEM file (#50.7).
+1 ;Naked reference below refers to ^PS(50.7,+Y,0)
+2 SET SCR("S")="S ND=$P($G(^(0)),U,4) I ND=""""!(ND>PSSFL)"
+3 QUIT
SSET(PSSC,PSSCNT,PSSI,DIR,SUB) ;Pull back a subset of the PHARMACY ORDERABLE ITEM file (#50.7)
+1 ;
+2 NEW PSSJ,PS0,Y,PSSIDT
+3 FOR
if PSSC'<PSSCNT
QUIT
SET PSSI=$ORDER(^PS(50.7,"B",PSSI),DIR)
if PSSI=""
QUIT
SET PSSJ=0
FOR
SET PSSJ=$ORDER(^PS(50.7,"B",PSSI,PSSJ))
if 'PSSJ
QUIT
IF $DATA(^PS(50.7,PSSJ,0))
SET PS0=^(0)
Begin DoDot:1
+4 SET Y=$PIECE(PS0,"^",4)
DO DD^%DT
SET PSSIDT=Y
+5 SET Y=$PIECE($GET(^PS(50.606,$PIECE(PS0,"^",2),0)),"^")
SET PSSC=PSSC+1
SET ^TMP(SUB,$JOB,1,PSSC)=PSSJ_"^"_PSSI_" "_Y_" "_PSSIDT
End DoDot:1
+6 QUIT
INDCATN(PSSIEN,LIST) ; *187 return Indications for Use for Prescription and Medication Order
+1 NEW I,J,K,IND,ARR
+2 IF +$GET(PSSIEN)'>0!($GET(LIST)']"")
QUIT
+3 KILL ^TMP($JOB,LIST)
SET I=""
SET K=0
+4 ;if most common indication exists, return its value
IF $PIECE($GET(^PS(50.7,PSSIEN,4)),"^",2)]""
SET K=1
SET IND=$$ENLU^PSSGMI($PIECE(^PS(50.7,PSSIEN,4),"^",2))
SET ^TMP($JOB,LIST,1)=IND_"^"_K
SET ARR(IND)=""
+5 FOR
SET I=$ORDER(^PS(50.7,PSSIEN,"IND","B",I))
if I=""
QUIT
Begin DoDot:1
+6 ;convert to uppercase
SET IND=$$ENLU^PSSGMI(I)
+7 IF '$DATA(ARR(IND))
SET ARR(IND)=""
End DoDot:1
+8 SET I=""
FOR
SET I=$ORDER(ARR(I))
if I=""
QUIT
IF $PIECE($GET(^TMP($JOB,LIST,1)),"^")'=I
SET K=K+1
SET ^TMP($JOB,LIST,K)=I
+9 SET I=""
SET K=0
KILL ARR
+10 ;if other most common indication exists, return its value
IF $PIECE($GET(^PS(50.7,PSSIEN,4)),"^",4)]""
SET K=1
SET IND=$$ENLU^PSSGMI($PIECE(^PS(50.7,PSSIEN,4),"^",4))
SET ^TMP($JOB,LIST,"OTH",1)=IND_"^"_K
SET ARR(IND)=""
+11 FOR
SET I=$ORDER(^PS(50.7,PSSIEN,"INDO","B",I))
if I=""
QUIT
Begin DoDot:1
+12 ;convert to uppercase
SET IND=$$ENLU^PSSGMI(I)
+13 IF '$DATA(ARR(IND))
SET ARR(IND)=""
End DoDot:1
+14 SET I=""
FOR
SET I=$ORDER(ARR(I))
if I=""
QUIT
IF $PIECE($GET(^TMP($JOB,LIST,"OTH",1)),"^")'=I
SET K=K+1
SET ^TMP($JOB,LIST,"OTH",K)=I
+15 QUIT
