source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSO52B.m@ 949

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1PSO52B ;BHAM ISC/AGV - Encap II API to return Rx data ;07/18/06 10:30 am
2 ;;7.0;OUTPATIENT PHARMACY;**252**;DEC 1997;Build 12
3 ;
4 ;Reference to ^PS(50.7 supported by DBIA 2223
5 ;
6 ;Rx profile called from RX^PSO52API
7 ;
8PT ;par
9 I '$O(^PSRX(IEN,"P",0)) S ^TMP($J,LIST,DFN,IEN,"P",0)="-1^NO DATA FOUND" Q
10 N PT F PT=0:0 S PT=$O(^PSRX(IEN,"P",PT)) Q:'PT S DA(52.2)=PT D PTP
11 K DA,DR,PST,DIC,DIQ,PT
12 Q
13PTP ;
14 S ^TMP($J,LIST,DFN,IEN,"P",0)=$G(^TMP($J,LIST,DFN,IEN,"P",0))+1
15 K PST S DR(52.2)=".01:8",DIC=52,DA=IEN,DR=60 D DIQ^PSO52API
16 F DR=.01,.02,.03,.04,.05,.06,.08,.09,.041,.042,1,5,6,8 D
17 .I PST(52.2,DA(52.2),DR,"E")'=PST(52.2,DA(52.2),DR,"I") S ^TMP($J,LIST,DFN,IEN,"P",DA(52.2),DR)=PST(52.2,DA(52.2),DR,"I")_"^"_PST(52.2,DA(52.2),DR,"E") Q
18 .S ^TMP($J,LIST,DFN,IEN,"P",DA(52.2),DR)=PST(52.2,DA(52.2),DR,"I")
19 Q
20SD ;sand
21 K PST S DIC=52,DA=IEN,DR="301;302;303" D DIQ^PSO52API F DR=301,302,303 D
22 .I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
23 .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
24 K DA,DR,PST,DIC,DIQ
25 Q
26TB ;tpb
27 K PST S DIC=52,DA=IEN,DR=201 D DIQ^PSO52API
28 I $G(PST(52,DA,DR,"E"))']"" S ^TMP($J,LIST,DFN,DA,DR)="" Q
29 S ^TMP($J,LIST,DFN,DA,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E")
30 K DA,DR,PST,DIC,DIQ
31 Q
32OI ;orderable item
33 K PST S DIC=52,DA=IEN,DR=39.2 D DIQ^PSO52API
34 I $G(PST(52,DA,DR,"I"))']"" S ^TMP($J,LIST,DFN,DA,"OI")="-1^NO DATA FOUND" Q
35 S ^TMP($J,LIST,DFN,DA,"OI")=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E")
36 S DIC=50.7,DA=PST(52,DA,DR,"I"),DR=.02,DIQ(0)="IE" D DIQ^PSO52API
37 S ^TMP($J,LIST,DFN,IEN,"OI")=^TMP($J,LIST,DFN,IEN,"OI")_"^"_PST(50.7,DA,DR,"I")_"^"_PST(50.7,DA,DR,"E")
38 K DA,DR,PST,DIC,DIQ
39 Q
40MLT ;ICD multiple
41 I '$O(^PSRX(IEN,"ICD",0)) S ^TMP($J,LIST,DFN,IEN,"ICD",0)="-1^NO DATA FOUND" Q
42 N MT F MT=0:0 S MT=$O(^PSRX(IEN,"ICD",MT)) Q:'MT S DA(52.052311)=MT D MULT
43 K DA,DR,PST,DIC,DIQ,MT
44 Q
45 ;
46MULT ;
47 S ^TMP($J,LIST,DFN,IEN,"ICD",0)=$G(^TMP($J,LIST,DFN,IEN,"ICD",0))+1
48 K PST S DR(52.052311)=".01:7" S DIC=52,DA=IEN,DR=52311 D DIQ^PSO52API
49 F DR=.01,1,2,3,4,5,6,7 D
50 .I PST(52.052311,DA(52.052311),DR,"E")'=PST(52.052311,DA(52.052311),DR,"I") S ^TMP($J,LIST,DFN,IEN,"ICD",DA(52.052311),DR)=PST(52.052311,DA(52.052311),DR,"I")_"^"_PST(52.052311,DA(52.052311),DR,"E") Q
51 .S ^TMP($J,LIST,DFN,IEN,"ICD",DA(52.052311),DR)=PST(52.052311,DA(52.052311),DR,"I")
52 K DA,DR,PST,DIC,DIQ
53 Q
Note: See TracBrowser for help on using the repository browser.