source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50NDF.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1PSS50NDF ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;External reference to PS(50.605 supported by DBIA 2138
4 ;
5SETND ;
6 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
7 S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
8 S ^TMP($J,LIST,+PSS(1),20)=$S($G(^TMP("PSSP50",$J,50,PSS(1),20,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),20,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),20,"E")))
9 S ^TMP($J,LIST,+PSS(1),21)=$G(^TMP("PSSP50",$J,50,PSS(1),21,"I"))
10 S ^TMP($J,LIST,+PSS(1),22)=$S($G(^TMP("PSSP50",$J,50,PSS(1),22,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),22,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),22,"E")))
11 S ^TMP($J,LIST,+PSS(1),23)=$S($G(^TMP("PSSP50",$J,50,PSS(1),23,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),23,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),23,"E")))
12 S ^TMP($J,LIST,+PSS(1),24)=$S($G(^TMP("PSSP50",$J,50,PSS(1),24,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),24,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),24,"E")))
13 N PSS50NCL S PSS50NCL=$S($G(^TMP("PSSP50",$J,50,PSS(1),25,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),25,"I")))
14 S ^TMP($J,LIST,+PSS(1),25)=$S($G(^TMP("PSSP50",$J,50,PSS(1),25,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),25,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),25,"E")))
15 I PSS50NCL S ^TMP($J,LIST,+PSS(1),25)=^TMP($J,LIST,+PSS(1),25)_"^"_$P($G(^PS(50.605,PSS50NCL,0)),"^",2)
16 S ^TMP($J,LIST,+PSS(1),27)=$G(^TMP("PSSP50",$J,50,PSS(1),27,"I"))
17 S ^TMP($J,LIST,+PSS(1),29)=$S($G(^TMP("PSSP50",$J,50,PSS(1),29,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),29,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),29,"E")))
18 Q
19LOOP ;
20 N PSSENCT
21 S PSSENCT=0
22 S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
23 .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
24 .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
25 .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
26 .;Naked reference below refers to ^PSDRUG(PSS(1),2)
27 .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
28 .I $G(PSSPK)]"",'PSSZ5 Q
29 .D SETNDL
30 .S PSSENCT=PSSENCT+1
31 S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
32 Q
33SETNDL ;
34 N PSSZNODE,PSS50NDN
35 S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS50NDN=$G(^("ND"))
36 S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
37 S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
38 N PSS50NDA D GETS^DIQ(50,+PSS(1),"20;21;22;23;24;25;27;29","IE","PSS50NDA")
39 S ^TMP($J,LIST,+PSS(1),20)=$S($G(PSS50NDA(50,+PSS(1)_",",20,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",20,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",20,"E")))
40 S ^TMP($J,LIST,+PSS(1),21)=$G(PSS50NDA(50,+PSS(1)_",",21,"I"))
41 S ^TMP($J,LIST,+PSS(1),22)=$S($G(PSS50NDA(50,+PSS(1)_",",22,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",22,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",22,"E")))
42 S ^TMP($J,LIST,+PSS(1),23)=$S($G(PSS50NDA(50,+PSS(1)_",",23,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",23,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",23,"E")))
43 S ^TMP($J,LIST,+PSS(1),24)=$S($G(PSS50NDA(50,+PSS(1)_",",24,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",24,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",24,"E")))
44 N PSS50NLL S PSS50NLL=$S($G(PSS50NDA(50,+PSS(1)_",",25,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",25,"I")))
45 S ^TMP($J,LIST,+PSS(1),25)=$S($G(PSS50NDA(50,+PSS(1)_",",25,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",25,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",25,"E")))
46 I PSS50NLL S ^TMP($J,LIST,+PSS(1),25)=^TMP($J,LIST,+PSS(1),25)_"^"_$P($G(^PS(50.605,PSS50NLL,0)),"^",2)
47 S ^TMP($J,LIST,+PSS(1),27)=$G(PSS50NDA(50,+PSS(1)_",",27,"I"))
48 S ^TMP($J,LIST,+PSS(1),29)=$S($G(PSS50NDA(50,+PSS(1)_",",29,"I"))="":"",1:$G(PSS50NDA(50,+PSS(1)_",",29,"I"))_"^"_$G(PSS50NDA(50,+PSS(1)_",",29,"E")))
49 Q
Note: See TracBrowser for help on using the repository browser.