source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPGET3.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: 2.6 KB
RevLine 
[613]1PPPGET3 ;ALB/DMB/DAD - MISC GET ROUTINES ; 3/4/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**8,17,21**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5GETUCI(GLOBAL) ; Returns the UCI & Volume for the requested global
6 ; as ["UCI","VOL"]
7 ; GLOBAL = "DPT" gets DPT, "TMP" gets TMP
8 ;
9 N Y
10 Q:$S($G(GLOBAL)="DPT":0,$G(GLOBAL)="TMP":0,1:1) ""
11 S:GLOBAL="DPT" Y=$P($G(^PPP(1020.1,1,1)),"^")
12 S:GLOBAL="TMP" Y=$P($G(^PPP(1020.1,1,1)),"^",2)
13 Q "["""_$E(Y,1,3)_""","""_$E(Y,5,7)_"""]"
14 ;
15GETDOM(SNIFN) ; Returns the network address for institution
16 ;
17 N DOMIFN,DOMNM
18 ;
19 ;DAVE B (PPP*1*17 29OCT98)
20 ;old way relied on dinummed valued pointer to domain file
21 ;
22 I $D(^PPP(1020.8,"D",SNIFN)) S SITEIEN=$O(^PPP(1020.8,"D",SNIFN,0)),DOMNM=$P($G(^PPP(1020.8,SITEIEN,0)),"^",2) G DMN
23 I $D(^PPP(1020.8,SNIFN)) S DOMNM=$P($G(^PPP(1020.8,SNIFN,0)),"^",2)
24 ;
25DMN S DOMNM=$G(DOMNM) I $G(DOMNM)="" S DOMNN=" " Q DOMNM
26 S LNUM=0 I $G(DOMNM)]"" S LNUM=$O(^PPP(1020.8,"A",DOMNM,0))
27 I LNUM S DOMNM=$P(^PPP(1020.128,LNUM,0),"^",2)
28 Q DOMNM
29 ;
30GETXREF() ; Gets patient for edit from FF Xref file or adds new from
31 ; Pateint file
32 ;
33 N PPPPOP,USRABORT,DIR,DIRUT,RESULT
34 ;
35 S USRABORT=-1001,PPPPOP=0
36 S DIR("A")="Select Patient Name"
37 S DIR(0)="P^1020.2:EQMZL"
38 W ! D ^DIR
39 ;
40 I $D(DIRUT) S RESULT=USRABORT
41 E S RESULT=Y
42 ;
43 W !,"RESULT = ",RESULT
44 Q RESULT
45 ;
46GETINST() ; Gets Institution
47 ;
48 N PPPPOP,USRABORT,DIR,DIRUT,RESULT
49 ;
50 S USRABORT=-1001,PPPPOP=0
51 S DIR("A")="Select Institution Name: "
52 S DIR(0)="FAO^1:30^K:(X'=$C(32)&($L(X)<3)) X"
53 S DIR("?")="^D HLPINST1^PPPHLP01"
54 S DIR("??")="^D HLPI1^PPPHLP01"
55 W ! D ^DIR
56 ;
57 I $D(DIRUT) S RESULT=USRABORT
58 E S RESULT=Y
59 ;
60 Q RESULT
61 ;
62GETSNIFN(STATION,VERBOSE) ;RETURN IFN OF INSTITUTION
63 ;THIS WILL RETURN THE SAME INFORMATION THAT DIC RETURNS IN Y
64 ;
65 N DIC,X,Y,DTOUT,DUOUT,RESULT,USRABORT
66 ;
67 S USRABORT=-1001
68 S:'$D(STATION) STATION=""
69 S:'$D(VERBOSE) VERBOSE=0
70 S VERBOSE=$S(VERBOSE:"E",1:"")
71 ;
72 ;USER INTERFACE
73 S DIC(0)="M"_VERBOSE
74 I STATION="" D
75 .S DIC(0)=DIC(0)_"AQ"
76 S X=STATION
77 S DIC=4
78 D ^DIC
79 ;
80 ;USER ABORTED PROCESS
81 ;
82 I $D(DTOUT)!($D(DUOUT)) S RESULT=USRABORT
83 E S RESULT=Y
84 ;
85 Q RESULT
86 ;
87GETDOMNM(SNIFN) ; -- gets Domain name from DOMAIN file (4.2)
88 ;
89 ; SNIFN = pointer to domain file
90 ;
91 Q:SNIFN'?1N.N SNIFN
92 ;
93 N DIC,DA,DR,DIQ,PPPTMP,NAME
94 ;
95 I $D(^PPP(1020.8,"B",SNIFN)) S PPPIEN=$O(^PPP(1020.8,"B",SNIFN,0)),NAME=$P($G(^PPP(1020.8,PPPIEN,0)),"^",2)
96 S LNUM=0 I $G(NAME)]"" S LNUM=$O(^PPP(1020.128,"A",NAME,0))
97 I LNUM S NAME=$P(^PPP(1020.128,LNUM,0),"^",2),DMNNEW=$G(DMNNEW)+1
98 ;
99 Q $G(NAME)
Note: See TracBrowser for help on using the repository browser.