source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJ59P5.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1PSJ59P5 ;BIR/LDT,TSS - API FOR INFORMATION FROM FILE 59.5; 5 Sep 03
2 ;;5.0; INPATIENT MEDICATIONS ;**163,172**;16 DEC 97;Build 13
3 ;
4 ;Reference to ^DG(40.8 - DBIA 2269
5 ;
6ALL(PSJIEN,PSJFT,LIST) ;
7 ;PSJIEN - IEN of entry in 59.5.
8 ;PSJFT - Free Text name in 59.5 or "??" for all names
9 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
10 ; Field Number of the data piece being returned.
11 ;Returns NAME field (#.01), DIVISION field (#.02), and INACTIVATION DATE field (#19) of IV ROOM file (#59.5).
12 N DIERR,ZZERR,PSJ59P5,SCR,PSJ,PSJIEN2
13 I $G(LIST)']"" Q
14 K ^TMP($J,LIST)
15 I +$G(PSJIEN)'>0,($G(PSJFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
16 I $G(PSJIEN)]"",+$G(PSJIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
17 I +$G(PSJIEN)>0 S PSJIEN2=$$FIND1^DIC(59.5,"","A","`"_PSJIEN,,,"") D
18 .I +PSJIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
19 .S ^TMP($J,LIST,0)=1
20 .D GETS^DIQ(59.5,+PSJIEN2,".01;.02;19","IE","PSJ59P5") S PSJ(1)=0
21 .F S PSJ(1)=$O(PSJ59P5(59.5,PSJ(1))) Q:'PSJ(1) D SETALL
22 I +$G(PSJIEN)'>0,$G(PSJFT)="??" D Q
23 .D LOOPDIR
24 I +$G(PSJIEN)'>0,$G(PSJFT)]"" D
25 .D FIND^DIC(59.5,,"@;.01;","QP",PSJFT,,"B",,,"")
26 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
27 .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
28 ..S PSJIEN=+^TMP("DILIST",$J,PSJXLP,0) K PSJ59P5 D GETS^DIQ(59.5,+PSJIEN,".01;.02;19","IE","PSJ59P5") S PSJ(1)=0
29 ..F S PSJ(1)=$O(PSJ59P5(59.5,PSJ(1))) Q:'PSJ(1) D SETALL
30 K ^TMP("DILIST",$J)
31 Q
32 ;
33LOOPDIR ;LOOP FOR A DIRECT READ.
34 N PSJCNT S PSJCNT=0
35 S PSJIEN2=0
36 F S PSJIEN2=$O(^PS(59.5,PSJIEN2)) Q:'PSJIEN2 D
37 .D SETDIR
38 D COUNT
39 Q
40 ;
41SETALL ;
42 S ^TMP($J,LIST,+PSJ(1),.01)=$G(PSJ59P5(59.5,PSJ(1),.01,"I"))
43 S ^TMP($J,LIST,"B",$G(PSJ59P5(59.5,PSJ(1),.01,"I")),+PSJ(1))=""
44 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"))
45 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"))
46 Q
47 ;
48SETDIR ;
49 S ^TMP($J,LIST,+PSJIEN2,.01)=$P($G(^PS(59.5,PSJIEN2,0)),U,1)
50 S ^TMP($J,LIST,"B",$P($G(^PS(59.5,PSJIEN2,0)),U,1),+PSJIEN2)=""
51 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))
52 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)))
53 S PSJCNT=PSJCNT+1
54 Q
55 ;
56GETDATE(PSJDATE) ;RETURNS FORMATTED DATE
57 N Y S Y=PSJDATE X ^DD("DD")
58 Q $G(Y)
59 ;
60WRT(PSJDFN,PSJVAL,LIST) ;Sets Division field
61 ;PSJDFN = IV ROOM (REQUIRED)
62 ;PSJVAL = Division (REQUIRED)
63 ;LIST: Subscript name used in ^TMP global [REQUIRED]
64 I $G(PSJDFN)'>0 Q
65 I $G(PSJVAL)="" Q
66 I $G(LIST)="" Q
67 I '$D(^PS(59.5,PSJDFN)) S ^TMP($J,LIST,0)=0 Q
68 I $G(PSJVAL)'>0 S ^TMP($J,LIST,0)=0 Q
69 I '$D(^DG(40.8,PSJVAL,0)) S ^TMP($J,LIST,0)=0 Q
70 S $P(^PS(59.5,PSJDFN,0),"^",4)=PSJVAL,^TMP($J,LIST,0)=1 K PSJVAL,PSJDFN Q
71COUNT ;
72 I PSJCNT>0 S ^TMP($J,LIST,0)=PSJCNT
73 ELSE S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
74 Q
75 ;
Note: See TracBrowser for help on using the repository browser.