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

PSS51.m

Go to the documentation of this file. 
  1. PSS51 ;BIR/LDT - API FOR INFORMATION FROM FILE 51; 5 Sep 03
  1.  ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
  1.  ;
  1. ALL(PSSIEN,PSSFT,LIST) ;
  1.  ;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
  1.  ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
  1.  ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
  1.  ;Field Number of the data piece being returned.
  1.  ;Returns NAME field (#.01), SYNONYM field (#.05), EXPANSION field (#1), OTHER LANGUAGE EXPANSION field (#1.1),
  1.  ;MED ROUTE field (#2), SCHEDULE field (#3), INSTRUCTIONS field (#4), ADDITIONAL INSTRUCTION field (#5),
  1.  ;PLURAL field (#9), DEFAULT ADMIN TIMES field (#10), INTENDED USE field (#30), and FREQUENCY (IN MINUTES)
  1.  ;field (#31) of MEDICATION INSTRUCTION file (#51).
  1.  N DIERR,ZZERR,PSS51,PSS
  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.  I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"") 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(51,+PSSIEN2,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51") S PSS(1)=0
  1.  .F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D SETZRO
  1.  I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
  1.  .I PSSFT["??" D LOOP(1) Q
  1.  .D FIND^DIC(51,,"@;.01;1","QP",PSSFT,,"B",,,"")
  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 PSS51 D GETS^DIQ(51,+PSSIEN,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51") S PSS(1)=0
  1.  ..F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D SETZRO
  1.  K ^TMP("DILIST",$J)
  1.  Q
  1.  ;
  1. WARD(PSSIEN,PSSFT,LIST) ;
  1.  ;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
  1.  ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
  1.  ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
  1.  ;Field Number of the data piece being returned.
  1.  ;Returns NAME field (#.01),  WARD field (#.01), and DEFAULT ADMIN TIMES field (#.02) of WARD multiple (#51.01)
  1.  ;of MEDICATION INSTRUCTION file (#51).
  1.  N DIERR,ZZERR,PSS51,PSS,CNT
  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.  I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"") 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(51,+PSSIEN2,".01;20*","IE","PSS51") S PSS(1)=0
  1.  .F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D SETWARD1 S PSS(2)=0,CNT=0 D
  1.  ..F  S PSS(2)=$O(PSS51(51.01,PSS(2))) Q:'PSS(2)  D SETWARD2 S CNT=CNT+1
  1.  ..S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
  1.  I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
  1.  .I PSSFT["??" D LOOP(2) Q
  1.  .D FIND^DIC(51,,"@;.01","QP",PSSFT,,"B",,,"")
  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 PSS51 D GETS^DIQ(51,+PSSIEN,".01;20*","IE","PSS51") S PSS(1)=0
  1.  ..F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D SETWARD1 S PSS(2)=0,CNT=0 D
  1.  ...F  S PSS(2)=$O(PSS51(51.01,PSS(2))) Q:'PSS(2)  D SETWARD2 S CNT=CNT+1
  1.  ...S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
  1.  K ^TMP("DILIST",$J)
  1.  Q
  1.  ;
  1. LOOKUP(PSSIEN,PSSFT,LIST) ;
  1.  ;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
  1.  ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
  1.  ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
  1.  ;Field Number of the data piece being returned.
  1.  ;Returns NAME field (#.01), and EXPANSION field (#1) of MEDICATION INSTRUCTION file (#51).
  1.  N DIERR,ZZERR,PSS51,PSS
  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.  I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"") 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(51,+PSSIEN2,".01;1","IE","PSS51") S PSS(1)=0
  1.  .F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D SETZRO2
  1.  I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
  1.  .I PSSFT["??" D LOOP(3) Q
  1.  .D FIND^DIC(51,,"@;.01;1","QP",PSSFT,,"B",,,"")
  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 PSS51 D GETS^DIQ(51,+PSSIEN,".01;1","IE","PSS51") S PSS(1)=0
  1.  ..F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D SETZRO2
  1.  K ^TMP("DILIST",$J)
  1.  Q
  1.  ;
  1. CHK(PSSFT,LIST) ;
  1.  ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
  1.  ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
  1.  ;Field Number of the data piece being returned.
  1.  ;Returns NAME field (#.01) of MEDICATION INSTRUCTION file (#51).
  1.  N DIERR,ZZERR,PSS51,SCR,PSS
  1.  I $G(LIST)']"" Q
  1.  K ^TMP($J,LIST)
  1.  I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  S SCR("S")="I $P($G(^PS(51,+Y,0)),""^"",4)<2"
  1.  I PSSFT["??" D LOOP(4) Q
  1.  D FIND^DIC(51,,"@;.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 PSS51 D GETS^DIQ(51,+PSSIEN,".01","IE","PSS51") S PSS(1)=0
  1.  .F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D
  1.  ..S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
  1.  ..S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
  1.  Q
  1.  ;
  1. SETZRO ;
  1.  S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
  1.  S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
  1.  S ^TMP($J,LIST,+PSS(1),1)=$G(PSS51(51,PSS(1),1,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),.5)=$G(PSS51(51,PSS(1),.5,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),30)=$S($G(PSS51(51,PSS(1),30,"I"))="":"",1:PSS51(51,PSS(1),30,"I")_"^"_PSS51(51,PSS(1),30,"E"))
  1.  S ^TMP($J,LIST,+PSS(1),2)=$S($G(PSS51(51,PSS(1),2,"I"))="":"",1:PSS51(51,PSS(1),2,"I")_"^"_PSS51(51,PSS(1),2,"E"))
  1.  S ^TMP($J,LIST,+PSS(1),3)=$G(PSS51(51,PSS(1),3,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),4)=$G(PSS51(51,PSS(1),4,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),31)=$G(PSS51(51,PSS(1),31,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),5)=$G(PSS51(51,PSS(1),5,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),1.1)=$G(PSS51(51,PSS(1),1.1,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),10)=$G(PSS51(51,PSS(1),10,"I"))
  1.  S ^TMP($J,LIST,+PSS(1),9)=$G(PSS51(51,PSS(1),9,"I"))
  1.  Q
  1.  ;
  1. SETWARD1 ;
  1.  S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
  1.  S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
  1.  Q
  1.  ;
  1. SETWARD2 ;
  1.  S ^TMP($J,LIST,+PSS(1),"WARD",+PSS(2),.01)=$S($G(PSS51(51.01,PSS(2),.01,"I"))="":"",1:PSS51(51.01,PSS(2),.01,"I")_"^"_PSS51(51.01,PSS(2),.01,"E"))
  1.  S ^TMP($J,LIST,+PSS(1),"WARD",+PSS(2),.02)=$G(PSS51(51.01,PSS(2),.02,"I"))
  1.  Q
  1.  ;
  1. SETZRO2 ;
  1.  S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
  1.  S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
  1.  S ^TMP($J,LIST,+PSS(1),1)=$G(PSS51(51,PSS(1),1,"I"))
  1.  Q
  1.  ;
  1. LOOP(PSS) ;
  1.  N CNT,PSSIEN S CNT=0
  1.  S PSSIEN=0  F  S PSSIEN=$O(^PS(51,PSSIEN)) Q:'PSSIEN  D @PSS
  1.  S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
  1.  Q
  1. 1 ;
  1.  K PSS51 D GETS^DIQ(51,+PSSIEN,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51") S PSS(1)=0
  1.  F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D SETZRO S CNT=CNT+1
  1.  Q
  1.  ;
  1. 2 ;
  1.  N CNT2 S CNT2=0
  1.  K PSS51 D GETS^DIQ(51,+PSSIEN,".01;20*","IE","PSS51") S PSS(1)=0
  1.  F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D SETWARD1 S CNT=CNT+1,PSS(2)=0 D
  1.  .F  S PSS(2)=$O(PSS51(51.01,PSS(2))) Q:'PSS(2)  D SETWARD2 S CNT2=CNT2+1
  1.  .S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
  1.  Q
  1.  ;
  1. 3 ;
  1.  K PSS51 D GETS^DIQ(51,+PSSIEN,".01;1","IE","PSS51") S PSS(1)=0
  1.  F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D SETZRO2 S CNT=CNT+1
  1.  Q
  1.  ;
  1. 4 ;
  1.  Q:$P($G(^PS(51,+PSSIEN,0)),"^",4)>1
  1.  K PSS51 D GETS^DIQ(51,+PSSIEN,".01","IE","PSS51") S PSS(1)=0
  1.  F  S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1)  D
  1.  .S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
  1.  .S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
  1.  .S CNT=CNT+1
  1.  Q
  1.  ;
  1. A(PSSFT,LIST) ;
  1.  ;PSSFT - Free Text Name in Medication Instruction file (#51).
  1.  ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,
  1.  ;Returns NAME field (#.01),  EXPANSION field (#1), OTHER LANGUAGE EXPANSION field (#1.1), and PLURAL field (#9)
  1.  ;of MEDICATION INSTRUCTION file (#51).
  1.  N PSSAENT,PSSAENTN
  1.  I $G(LIST)']"" Q
  1.  K ^TMP($J,LIST)
  1.  I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  I '$D(^PS(51,"A",PSSFT))  S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  S PSSAENT=$O(^PS(51,"B",PSSFT,0)) I 'PSSAENT S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  S PSSAENTN=$G(^PS(51,PSSAENT,0)) I $P(PSSAENTN,"^")="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  S ^TMP($J,LIST,0)=1
  1.  S ^TMP($J,LIST,+PSSAENT,.01)=$P(PSSAENTN,"^")
  1.  S ^TMP($J,LIST,"A",$P(PSSAENTN,"^"),+PSSAENT)=""
  1.  S ^TMP($J,LIST,+PSSAENT,1)=$P(PSSAENTN,"^",2)
  1.  S ^TMP($J,LIST,+PSSAENT,1.1)=$P($G(^PS(51,+PSSAENT,4)),"^")
  1.  S ^TMP($J,LIST,+PSSAENT,9)=$P($G(^PS(51,+PSSAENT,9)),"^")
  1.  Q