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

PSJ59P5.m

Go to the documentation of this file. 
  1. PSJ59P5 ;BIR/LDT,TSS - API FOR INFORMATION FROM FILE 59.5; 5 Sep 03
  1.  ;;5.0; INPATIENT MEDICATIONS ;**163,172**;16 DEC 97;Build 13
  1.  ;
  1.  ;Reference to ^DG(40.8 - DBIA 2269
  1.  ;
  1. ALL(PSJIEN,PSJFT,LIST) ;
  1.  ;PSJIEN - IEN of entry in 59.5.
  1.  ;PSJFT - Free Text name in 59.5 or "??" for all names
  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), DIVISION field (#.02), and INACTIVATION DATE field (#19) of IV ROOM file (#59.5).
  1.  N DIERR,ZZERR,PSJ59P5,SCR,PSJ,PSJIEN2
  1.  I $G(LIST)']"" Q
  1.  K ^TMP($J,LIST)
  1.  I +$G(PSJIEN)'>0,($G(PSJFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  I $G(PSJIEN)]"",+$G(PSJIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  I +$G(PSJIEN)>0 S PSJIEN2=$$FIND1^DIC(59.5,"","A","`"_PSJIEN,,,"") D
  1.  .I +PSJIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
  1.  .S ^TMP($J,LIST,0)=1
  1.  .D GETS^DIQ(59.5,+PSJIEN2,".01;.02;19","IE","PSJ59P5") S PSJ(1)=0
  1.  .F  S PSJ(1)=$O(PSJ59P5(59.5,PSJ(1))) Q:'PSJ(1)  D SETALL
  1.  I +$G(PSJIEN)'>0,$G(PSJFT)="??" D  Q
  1.  .D LOOPDIR
  1.  I +$G(PSJIEN)'>0,$G(PSJFT)]"" D
  1.  .D FIND^DIC(59.5,,"@;.01;","QP",PSJFT,,"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 PSJXLP S PSJXLP=0 F  S PSJXLP=$O(^TMP("DILIST",$J,PSJXLP)) Q:'PSJXLP  D
  1.  ..S PSJIEN=+^TMP("DILIST",$J,PSJXLP,0) K PSJ59P5 D GETS^DIQ(59.5,+PSJIEN,".01;.02;19","IE","PSJ59P5") S PSJ(1)=0
  1.  ..F  S PSJ(1)=$O(PSJ59P5(59.5,PSJ(1))) Q:'PSJ(1)  D SETALL
  1.  K ^TMP("DILIST",$J)
  1.  Q
  1.  ;
  1. LOOPDIR ;LOOP FOR A DIRECT READ.
  1.  N PSJCNT S PSJCNT=0
  1.  S PSJIEN2=0
  1.  F  S PSJIEN2=$O(^PS(59.5,PSJIEN2)) Q:'PSJIEN2  D
  1.  .D SETDIR
  1.  D COUNT
  1.  Q
  1.  ;
  1. SETALL ;
  1.  S ^TMP($J,LIST,+PSJ(1),.01)=$G(PSJ59P5(59.5,PSJ(1),.01,"I"))
  1.  S ^TMP($J,LIST,"B",$G(PSJ59P5(59.5,PSJ(1),.01,"I")),+PSJ(1))=""
  1.  S ^TMP($J,LIST,+PSJ(1),.02)=$S($G(PSJ59P5(59.5,PSJ(1),.02,"I"))="":"",1:PSJ59P5(59.5,PSJ(1),.02,"I")_"^"_PSJ59P5(59.5,PSJ(1),.02,"E"))
  1.  S ^TMP($J,LIST,+PSJ(1),19)=$S($G(PSJ59P5(59.5,PSJ(1),19,"I"))="":"",1:PSJ59P5(59.5,PSJ(1),19,"I")_"^"_PSJ59P5(59.5,PSJ(1),19,"E"))
  1.  Q
  1.  ;
  1. SETDIR ;
  1.  S ^TMP($J,LIST,+PSJIEN2,.01)=$P($G(^PS(59.5,PSJIEN2,0)),U,1)
  1.  S ^TMP($J,LIST,"B",$P($G(^PS(59.5,PSJIEN2,0)),U,1),+PSJIEN2)=""
  1.  S ^TMP($J,LIST,+PSJIEN2,.02)=$S($P($G(^PS(59.5,PSJIEN2,0)),U,4)="":"",1:$P($G(^PS(59.5,PSJIEN2,0)),U,4)_"^"_$P($G(^DG(40.8,$P($G(^PS(59.5,PSJIEN2,0)),U,4),0)),U,1))
  1.  S ^TMP($J,LIST,+PSJIEN2,19)=$S($P($G(^PS(59.5,PSJIEN2,"I")),U,1)="":"",1:$P($G(^PS(59.5,PSJIEN2,"I")),U,1)_"^"_$$GETDATE($P($G(^PS(59.5,PSJIEN2,"I")),U,1)))
  1.  S PSJCNT=PSJCNT+1
  1.  Q
  1.  ;
  1. GETDATE(PSJDATE) ;RETURNS FORMATTED DATE
  1.  N Y S Y=PSJDATE X ^DD("DD")
  1.  Q $G(Y)
  1.  ;
  1. WRT(PSJDFN,PSJVAL,LIST) ;Sets Division field
  1.  ;PSJDFN = IV ROOM (REQUIRED)
  1.  ;PSJVAL = Division (REQUIRED)
  1.  ;LIST: Subscript name used in ^TMP global [REQUIRED]
  1.  I $G(PSJDFN)'>0 Q
  1.  I $G(PSJVAL)="" Q
  1.  I $G(LIST)="" Q
  1.  I '$D(^PS(59.5,PSJDFN)) S ^TMP($J,LIST,0)=0 Q
  1.  I $G(PSJVAL)'>0 S ^TMP($J,LIST,0)=0 Q
  1.  I '$D(^DG(40.8,PSJVAL,0)) S ^TMP($J,LIST,0)=0 Q
  1.  S $P(^PS(59.5,PSJDFN,0),"^",4)=PSJVAL,^TMP($J,LIST,0)=1 K PSJVAL,PSJDFN Q
  1. COUNT ;
  1.  I PSJCNT>0 S ^TMP($J,LIST,0)=PSJCNT
  1.  ELSE  S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
  1.  Q
  1.  ;