source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPST08.m@ 789

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PPPST08 ;ALB/JFP - PPP, SET UP MAIL GROUP;01MAR94
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5MAIL() ; Main entry point for adding mail group.
6 ; INPUT : NONE
7 ; OUTPUT : 0 - success
8 ; -1 - unsucessful
9 ;
10 ; (note: These calls will change to the support mailman entry pts
11 ; once they are verified.
12 ;
13MGEDT ; Add the Prescription Practices Mailgroup
14 ;
15 N Y,X,DA,DIC,DR,DUOUT,DTOUT,DIE,OUTCODE
16 S OUTCODE=0
17 S Y=$O(^XMB(3.8,"B","PRESCRIPTION PRACTICES",0))
18 I 'Y D
19 .S DIC(0)="L",DIC=3.8,X="PRESCRIPTION PRACTICES"
20 .S DLAYGO=3.8
21 .D ^DIC
22 W !
23 I +Y>0 D
24 .W !!,">>> Please Add Users To Mail Group..."
25 .S DA=+Y,DIE=3.8
26 .S DR="3///Used to alert users of problems encountered with the Prescription Practices Utilities."
27 .S DR(1,3.8,1)="4///private"
28 .S DR(1,3.8,2)="5////"_DUZ
29 .S DR(1,3.8,3)="10///UNRESTRICTED"
30 .S DR(1,3.8,4)="2"
31 .D ^DIE
32 E S OUTCODE=-1
33 Q OUTCODE
34 ;
35 ;
36MAIL1() ; -- Adds new mail group members
37 ;
38 ; INPUT : NONE
39 ; OUTPUT : 0 - success
40 ; -1 - unsucessful
41 ;
42 ; (note: These calls uses the API in Mailman v7.1 for creating mail
43 ; groups
44 ;
45 N IPPP,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
46 N APPP,BPPP,CPPP,DPPP,EPPP,FPPP,GPPP,ERR
47 ;
48 W !!,">>> Please add Users to the Prescription Practices Mail Group..."
49 F IPPP=1:1 D Q:$D(DIRUT)
50 .S DIR(0)="PO^200:EQM"
51 .S DIR("A")="Select Member"
52 .S DIR("B")=""
53 .D ^DIR
54 .I $D(DIRUT) Q
55 .S EPPP($P(Y,"^",1))=""
56 K DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
57 ;
58MG1 ; -- Inputs:
59 S APPP="PRESCRIPTION PRACTICES"
60 S BPPP="1" ; -- private
61 S CPPP=$G(DUZ)
62 S DPPP="1" ; -- no
63 S EPPP=""
64 S FPPP(1)="Used to notify users of problems encountered with the Prescription Practices Utilities"
65 S GPPP="1" ; -- silent
66 ;
67 ; -- Outputs
68 ; X - sucessful value of mail group number
69 ; - unsucessful 0
70 ; -- Call
71 S ERR=$$MG^XMBGRP(APPP,BPPP,CPPP,DPPP,.EPPP,.FPPP,GPPP)
72 I ERR>0 D Q 0
73 .W !,"Mail group created..entry number = ",ERR
74 Q -1 ; -- error
75 ;
Note: See TracBrowser for help on using the repository browser.