- 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 Jan 18, 2025@03:30:40 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