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

PSS50P66.m

Go to the documentation of this file. 
  1. PSS50P66 ;BIR/LDT - API FOR INFORMATION FROM FILE 50.606; 5 Sep 03
  1.  ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
  1.  ;
  1. ALL(PSSIEN,PSSFT,PSSFL,LIST) ;
  1.  ;PSSIEN - IEN of entry in DOSAGE FORM file (#50.606).
  1.  ;PSSFT - Free Text name in DOSAGE FORM file (#50.606).
  1.  ;PSSFL - Inactive flag - "" - All entries.
  1.  ;        FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
  1.  ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where
  1.  ;       Field Number is the Field Number of the data piece being returned.
  1.  ;Returns NAME field (#.01), VERB field (#3), PREPOSITION field (#5), INACTIVE DATE field (#7),
  1.  ;MED ROUTE FOR DOSAGE FORM multiple (#50.6061), MED ROUTE FOR DOSAGE FORM field (#.01), and NOUN multiple (#50.6066),
  1.  ;NOUN field (#.01) of DOSAGE FORM file (#50.606).
  1.  N DIERR,ZZERR,PSS,CNT,CNT1,SCR
  1.  I $G(LIST)']"" Q
  1.  K ^TMP($J,LIST)
  1.  I $G(PSSIEN)']"",($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  S SCR("S")=""
  1.  I +$G(PSSFL)>0 N ND D SETSCRN
  1.  I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50.606,"","X","`"_PSSIEN,,SCR("S"),"") D
  1.  .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  .S ^TMP($J,LIST,0)=1
  1.  .D GETS^DIQ(50.606,+PSSIEN2,".01;3;5;7;1*;6*","IE","^TMP($J,""PSS50P66""") S PSS(1)=0 D
  1.  ..F  S PSS(1)=$O(^TMP($J,"PSS50P66",50.606,PSS(1))) Q:'PSS(1)  D SETZRO
  1.  ..S (CNT,PSS(2))=0 F  S PSS(2)=$O(^TMP($J,"PSS50P66",50.6061,PSS(2))) Q:'PSS(2)  D SETMRDF S CNT=CNT+1
  1.  ..S ^TMP($J,LIST,+PSSIEN,"MRDSFRM",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
  1.  ..S (CNT1,PSS(3))=0 F  S PSS(3)=$O(^TMP($J,"PSS50P66",50.6066,PSS(3))) Q:'PSS(3)  D SETNOUN S CNT1=CNT1+1
  1.  ..S ^TMP($J,LIST,+PSSIEN,"NOUN",0)=$S($G(CNT1)>0:CNT1,1:"-1^NO DATA FOUND")
  1.  I $G(PSSIEN)="",$G(PSSFT)]"" D
  1.  .I PSSFT["??" D LOOP Q
  1.  .D FIND^DIC(50.606,,"@;.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) K ^TMP($J,"PSS50P66") D GETS^DIQ(50.606,+PSSIEN,".01;3;5;7;1*;6*","IE","^TMP($J,""PSS50P66""") S PSS(1)=0
  1.  ..F  S PSS(1)=$O(^TMP($J,"PSS50P66",50.606,PSS(1))) Q:'PSS(1)  D SETZRO
  1.  ..S (CNT,PSS(2))=0 F  S PSS(2)=$O(^TMP($J,"PSS50P66",50.6061,PSS(2))) Q:'PSS(2)  D SETMRDF S CNT=CNT+1
  1.  ..S ^TMP($J,LIST,+PSSIEN,"MRDSFRM",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
  1.  ..S (CNT1,PSS(3))=0 F  S PSS(3)=$O(^TMP($J,"PSS50P66",50.6066,PSS(3))) Q:'PSS(3)  D SETNOUN S CNT1=CNT1+1
  1.  ..S ^TMP($J,LIST,+PSSIEN,"NOUN",0)=$S($G(CNT1)>0:CNT1,1:"-1^NO DATA FOUND")
  1.  K ^TMP("DILIST",$J),^TMP($J,"PSS50P66")
  1.  Q
  1.  ;
  1. ADD(PSSIEN,PSSMR) ;
  1.  ;PSSIEN - IEN of entry in DOSAGE FORM file (#50.606).
  1.  ;PSSMR - IEN of entry in MEDICATION ROUTES file (#51.2).
  1.  ;0 (zero)is returned if ADD was unsuccessful.  1 (one) will indicate successful ADD.
  1.  ;Adding new entry to MED ROUTE FOR DOSAGE FORM multiple (#50.6061) of the DOSAGE FORM file (#50.606).
  1.  I (+$G(PSSIEN)'>0),(+$G(PSSMR)'>0) Q 0
  1.  N PSS,QFLG
  1.  N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.2,"","A","`"_PSSMR,,,"")
  1.  I +PSSIEN2'>0 Q 0
  1.  N PSSIEN3 S PSSIEN3=$$FIND1^DIC(50.606,"","A","`"_PSSIEN,,,"")
  1.  I +PSSIEN3'>0 Q 0
  1.  D LIST^DIC(50.6061,","_PSSIEN_",","@;.01IE","P",,,,,,,)
  1.  I +^TMP("DILIST",$J,0)'>0 D
  1.  .S PSS(1,50.6061,"+2,"_PSSIEN_",",.01)=$G(PSSMR)
  1.  I +^TMP("DILIST",$J,0)>0 S (QFLG,PSS)=0 F  S PSS=$O(^TMP("DILIST",$J,PSS)) Q:'PSS  Q:QFLG  D
  1.  .I $P($G(^TMP("DILIST",$J,PSS,0)),"^",2)=PSSMR S QFLG=1 Q
  1.  .S PSS(1,50.6061,"+2,"_PSSIEN_",",.01)=$G(PSSMR)
  1.  I $G(QFLG) Q 0
  1.  D UPDATE^DIE("","PSS(1)") Q 1
  1.  Q
  1.  ;
  1. SETZRO ;
  1.  S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP($J,"PSS50P66",50.606,PSS(1),.01,"I"))
  1.  S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS50P66",50.606,PSS(1),.01,"I")),+PSS(1))=""
  1.  S ^TMP($J,LIST,+PSS(1),3)=$G(^TMP($J,"PSS50P66",50.606,PSS(1),3,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),5)=$G(^TMP($J,"PSS50P66",50.606,PSS(1),5,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),7)=$S($G(^TMP($J,"PSS50P66",50.606,PSS(1),7,"I"))="":"",1:^TMP($J,"PSS50P66",50.606,PSS(1),7,"I")_"^"_^TMP($J,"PSS50P66",50.606,PSS(1),7,"E"))
  1.  Q
  1. SETMRDF ;
  1.  S ^TMP($J,LIST,+PSSIEN,"MRDSFRM",+PSS(2),.01)=$S($G(^TMP($J,"PSS50P66",50.6061,PSS(2),.01,"I"))="":"",1:^TMP($J,"PSS50P66",50.6061,PSS(2),.01,"I")_"^"_^TMP($J,"PSS50P66",50.6061,PSS(2),.01,"E"))
  1.  Q
  1.  ;
  1. SETNOUN ;
  1.  S ^TMP($J,LIST,+PSSIEN,"NOUN",+PSS(3),.01)=$S($G(^TMP($J,"PSS50P66",50.6066,PSS(3),.01,"I"))="":"",1:^TMP($J,"PSS50P66",50.6066,PSS(3),.01,"I"))
  1.  Q
  1.  ;
  1. LOOP ;
  1.  N PSSIEN,CNT2,CNT1
  1.  S (CNT2,PSSIEN)=0 F  S PSSIEN=$O(^PS(50.606,PSSIEN)) Q:'PSSIEN  D
  1.  .I +$G(PSSFL)>0,$P($G(^PS(50.606,PSSIEN,0)),"^",2)]"",$P($G(^(0)),"^",2)'>PSSFL Q
  1.  .K ^TMP($J,"PSS50P66") D GETS^DIQ(50.606,+PSSIEN,".01;3;5;7;1*;6*","IE","^TMP($J,""PSS50P66""") S PSS(1)=0 D
  1.  ..F  S PSS(1)=$O(^TMP($J,"PSS50P66",50.606,PSS(1))) Q:'PSS(1)  D SETZRO S CNT2=CNT2+1
  1.  ..S (CNT,PSS(2))=0 F  S PSS(2)=$O(^TMP($J,"PSS50P66",50.6061,PSS(2))) Q:'PSS(2)  D SETMRDF S CNT=CNT+1
  1.  ..S (CNT1,PSS(3))=0 F  S PSS(3)=$O(^TMP($J,"PSS50P66",50.6066,PSS(3))) Q:'PSS(3)  D SETNOUN S CNT1=CNT1+1
  1.  ..S ^TMP($J,LIST,+PSSIEN,"MRDSFRM",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
  1.  ..S ^TMP($J,LIST,0)=$S($G(CNT2)>0:CNT2,1:"-1^NO DATA FOUND")
  1.  ..S ^TMP($J,LIST,+PSSIEN,"NOUN",0)=$S($G(CNT1)>0:CNT1,1:"-1^NO DATA FOUND")
  1.  K ^TMP($J,"PSS50P66")
  1.  Q
  1.  ;
  1. SETSCRN ;
  1.  S SCR("S")="S ND=$P($G(^PS(50.606,+Y,0)),""^"",2) I ND=""""!(ND>PSSFL)"
  1.  Q