Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSS50DAT

PSS50DAT.m

Go to the documentation of this file.
  1. PSS50DAT ;BHAM ISC/TSS - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**85,92,112,118**;9/30/97;Build 8
  1. DATA ;
  1. ;PSSIEN - IEN of entry in 50
  1. ;PSSFT - Free Text name in 50
  1. ;PSSFL - Inactive flag - "" - All entries
  1. ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
  1. ;PSSPK - Application Package's Use - "" - All entries
  1. ; Alphabetic codes that represent the DHCP packages that consider this drug to be
  1. ; part of their formulary.
  1. ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
  1. ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
  1. ; piece being returned.
  1. ;Reference to ^PSNDF(50.68 is supported by DBIA 3735
  1. ;NEW UNPROTECTED FILEMAN VARIABLES
  1. N DO,DINDEX,DISUB,DIVAL
  1. N PSSBGCNT
  1. N PSSCNT
  1. N PSSTIEN
  1. N PSSTMP
  1. N PSSOLD
  1. N PSSALT
  1. N PSSMATCH
  1. N PSSSYN
  1. N PSSCAP
  1. S PSSBGCNT=0
  1. S SCR("S")=""
  1. I $G(LIST)']"" Q
  1. I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. K ^TMP("DILIST",$J)
  1. K ^TMP($J,LIST)
  1. S SCR("S")=""
  1. I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
  1. I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) D COUNTBG Q
  1. .I PSSIEN2>0 D DIRREAD
  1. I +$G(PSSIEN)=0 D
  1. .I PSSFT="??" D LOOPDIR D COUNTBG Q
  1. .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"") D LOOPDI D COUNTBG
  1. Q
  1. ;
  1. COUNTBG ;CHECKS PSSBGCNT AND FILLS COUNT IN ON 0 NODE OF ^TMP($J,LIST)
  1. I PSSBGCNT>0 D
  1. .S ^TMP($J,LIST,0)=PSSBGCNT
  1. ELSE S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
  1. Q
  1. ;
  1. LOOPDI ;LOOPS ON "DILIST" FROM FILEMAN CALL (USED FOR RETURNING MULTIPLE DRUGS FROM PSSFT)
  1. S PSSTIEN=0 ;TEMP IEN TO ITERATE OVER DILIST
  1. F S PSSTIEN=$O(^TMP("DILIST",$J,PSSTIEN)) Q:PSSTIEN="" D
  1. .S PSSIEN2=($P(^TMP("DILIST",$J,PSSTIEN,0),U,1))
  1. .D DIRREAD
  1. Q
  1. ;
  1. LOOPDIR ;LOOP FOR A DIRECT READ. READS ALL IENs FOR ^PSDRUG(
  1. S PSSIEN2=0
  1. F S PSSIEN2=$O(^PSDRUG(PSSIEN2)) Q:'PSSIEN2 D
  1. .I $P($G(^PSDRUG(PSSIEN2,0)),U,1)'="" D DIRALL
  1. Q
  1. ;
  1. DIRALL ;TEST FOR PSSFL, PSSRTOI, PSSPK, BAILS IF CONDITIONS MEET TRUE
  1. I $G(PSSFL),$P($G(^PSDRUG(PSSIEN2,"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
  1. I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSSIEN2,2)),"^") Q
  1. I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5 I $P($G(^PSDRUG(PSSIEN2,2)),U,3)[$E(PSSPK,PSSZ6) S PSSZ5=1
  1. I $G(PSSPK)]"",'PSSZ5 Q
  1. D DIRREAD
  1. Q
  1. ;
  1. DIRREAD ;MAIN DIRECT READ FOR ENTIRE ROUTINE
  1. D DIRREAD^PSS50TMP
  1. D SYNONYM
  1. S ^TMP($J,LIST,"B",$G(^TMP($J,LIST,PSSIEN2,.01)),PSSIEN2)=""
  1. D FORMALT
  1. D OLD
  1. D SRVCODE($P(^TMP($J,LIST,PSSIEN2,22),U,1))
  1. S PSSBGCNT=PSSBGCNT+1
  1. Q
  1. ;
  1. SYNONYM ; FILLS SYNONYM MULTIPLE
  1. S PSSCNT=0
  1. S PSSTMP=""
  1. S PSSSYN=""
  1. F S PSSSYN=$O(^PSDRUG(PSSIEN2,1,PSSSYN)) Q:PSSSYN="" D
  1. .I $P($G(^PSDRUG(PSSIEN2,1,PSSSYN,0)),U,1)'="" D
  1. ..S ^TMP($J,LIST,PSSIEN2,"SYN",PSSSYN,.01)=$P($G(^PSDRUG(PSSIEN2,1,PSSSYN,0)),U,1)
  1. ..;;;;;INTENDED USE
  1. ..S PSSTMP=$P($G(^PSDRUG(PSSIEN2,1,PSSSYN,0)),U,3)
  1. ..I PSSTMP="0" S ^TMP($J,LIST,PSSIEN2,"SYN",PSSSYN,1)=PSSTMP_U_"TRADE NAME"
  1. ..I PSSTMP="1" S ^TMP($J,LIST,PSSIEN2,"SYN",PSSSYN,1)=PSSTMP_U_"QUICK CODE"
  1. ..I PSSTMP="D" S ^TMP($J,LIST,PSSIEN2,"SYN",PSSSYN,1)=PSSTMP_U_"DRUG ACCOUNTABILITY"
  1. ..I PSSTMP="C" S ^TMP($J,LIST,PSSIEN2,"SYN",PSSSYN,1)=PSSTMP_U_"CONTROLLED SUBSTANCES"
  1. ..I PSSTMP="" S ^TMP($J,LIST,PSSIEN2,"SYN",PSSSYN,1)=""
  1. ..;;;;;NDC CODE
  1. ..S ^TMP($J,LIST,PSSIEN2,"SYN",PSSSYN,2)=$P($G(^PSDRUG(PSSIEN2,1,PSSSYN,0)),U,2)
  1. ..S ^TMP($J,LIST,PSSIEN2,"SYN",PSSSYN,403)=$P($G(^PSDRUG(PSSIEN2,1,PSSSYN,0)),U,7)
  1. ..S PSSCNT=PSSCNT+1
  1. I PSSCNT=0 S ^TMP($J,LIST,PSSIEN2,"SYN",0)="-1^NO DATA FOUND"
  1. ELSE S ^TMP($J,LIST,PSSIEN2,"SYN",0)=PSSCNT
  1. Q
  1. ;
  1. FORMALT ;FILLS FORMULARY ALTERATIVE MULTIPLE
  1. S PSSCNT=0
  1. S PSSALT=0
  1. F S PSSALT=$O(^PSDRUG(PSSIEN2,65,PSSALT)) Q:PSSALT="" D
  1. .I $P($G(^PSDRUG(PSSIEN2,65,PSSALT,0)),U,1)'="" D
  1. ..S ^TMP($J,LIST,PSSIEN2,"FRM",PSSALT,2)=$P($G(^PSDRUG(PSSIEN2,65,PSSALT,0)),U,1)_U_$P($G(^PSDRUG($P($G(^PSDRUG(PSSIEN2,65,PSSALT,0)),U,1),0)),U,1)
  1. ..S PSSCNT=PSSCNT+1
  1. I PSSCNT=0 S ^TMP($J,LIST,PSSIEN2,"FRM",0)="-1^NO DATA FOUND"
  1. ELSE S ^TMP($J,LIST,PSSIEN2,"FRM",0)=PSSCNT
  1. Q
  1. ;
  1. OLD ;FILLS THE OLD NAME MULTIPLE
  1. S PSSCNT=0
  1. S PSSOLD=0
  1. F S PSSOLD=$O(^PSDRUG(PSSIEN2,900,PSSOLD)) Q:PSSOLD="" D
  1. .I $P($G(^PSDRUG(PSSIEN2,900,PSSOLD,0)),U,2)'="" D
  1. ..S PSSCAP=$$UP^XLFSTR($$FMTE^XLFDT($P(^PSDRUG(PSSIEN2,900,PSSOLD,0),U,2)))
  1. ..S ^TMP($J,LIST,PSSIEN2,"OLD",PSSOLD,.02)=$P($G(^PSDRUG(PSSIEN2,900,PSSOLD,0)),U,2)_U_PSSCAP
  1. .ELSE S ^TMP($J,LIST,PSSIEN2,"OLD",PSSOLD,.02)=""
  1. .I $P($G(^PSDRUG(PSSIEN2,900,PSSOLD,0)),U,1)'="" D
  1. ..S ^TMP($J,LIST,PSSIEN2,"OLD",PSSOLD,.01)=$P($G(^PSDRUG(PSSIEN2,900,PSSOLD,0)),U,1)
  1. ..S PSSCNT=PSSCNT+1
  1. .ELSE S ^TMP($J,LIST,PSSIEN2,"OLD",PSSOLD,.01)=""
  1. I PSSCNT=0 S ^TMP($J,LIST,PSSIEN2,"OLD",0)="-1^NO DATA FOUND"
  1. ELSE S ^TMP($J,LIST,PSSIEN2,"OLD",0)=PSSCNT
  1. Q
  1. ;
  1. SRVCODE(PSSMATCH) ;FILLS SERVICE CODE MULTIPLE
  1. I PSSMATCH'="" S ^TMP($J,LIST,PSSIEN2,400)=$P($G(^PSNDF(50.68,PSSMATCH,"PFS")),U,1)
  1. I $P($G(^TMP($J,LIST,PSSIEN2,400)),U,1)="" S ^TMP($J,LIST,PSSIEN2,400)=$P($G(^PSDRUG(PSSIEN2,"PFS")),U,1)
  1. I $P($G(^TMP($J,LIST,PSSIEN2,400)),U,1)="" S ^TMP($J,LIST,PSSIEN2,400)=600000
  1. Q
  1. ;
  1. DRG ;
  1. ;PSSIEN - IEN of entry in 50
  1. ;PSSFT - Free Text name in 50
  1. ;PSSFL - Inactive flag - "" - All entries
  1. ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
  1. ;PSSPK - Application Package's Use - "" - All entries
  1. ; Alphabetic codes that represent the DHCP packages that consider this drug to be
  1. ; part of their formulary.
  1. ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
  1. ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
  1. ; piece being returned.
  1. N DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT
  1. I $G(LIST)']"" Q
  1. K ^TMP($J,LIST)
  1. I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. S SCR("S")=""
  1. I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
  1. I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
  1. .K ^TMP("DIERR",$J)
  1. .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .S ^TMP($J,LIST,0)=1
  1. .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;62.01:62.05;905","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
  1. .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETDRG^PSS50A1
  1. I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. I $G(PSSFT)]"" D
  1. .I PSSFT["??" D LOOP^PSS50A1 Q
  1. .K ^TMP("DILIST",$J)
  1. .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
  1. .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1. .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
  1. ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
  1. ..K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;62.01:62.05;905","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
  1. ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETDRG^PSS50A1
  1. K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
  1. Q
  1. ;
  1. LOOP ;
  1. N PSS50DD1,PSS50DD2,PSS50DD3,PSS50DD4,PSS50ER1,PSS50ER2,PSS50ER3,PSS50ER4,PSS51NFD,PSS52NFD,PSSG2N,PSS501NX
  1. D FIELD^DID(50,51,"Z","POINTER","PSS50DD1","PSS50ER1") S PSS51NFD=$G(PSS50DD1("POINTER"))
  1. D FIELD^DID(50,52,"Z","POINTER","PSS50DD2","PSS50ER2") S PSS52NFD=$G(PSS50DD2("POINTER"))
  1. D FIELD^DID(50,301,"Z","POINTER","PSS50DD3","PSS50ER3") S PSSG2N=$G(PSS50DD3("POINTER"))
  1. D FIELD^DID(50.1,1,"Z","POINTER","PSS50DD4","PSS50ER4") S PSS501NX=$G(PSS50DD4("POINTER"))
  1. N PSSENCT
  1. S PSSENCT=0
  1. S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
  1. .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
  1. .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
  1. .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
  1. .;Naked reference below refers to ^PSDRUG(PSS(1),2)
  1. .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
  1. .I $G(PSSPK)]"",'PSSZ5 Q
  1. .D SETSUB1^PSS50AQM(PSS(1)),SETSUB2^PSS50AQM(PSS(1)),SETSUB3^PSS50AQM(PSS(1))
  1. .D SETALL^PSS50AQM,SETOLD^PSS50AQM,SETSYN^PSS50AQM,SETFMA^PSS50AQM
  1. .S PSSENCT=PSSENCT+1
  1. S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
  1. Q