1 | PPPST08 ;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 | ;
|
---|
5 | MAIL() ; 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 | ;
|
---|
13 | MGEDT ; 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 | ;
|
---|
36 | MAIL1() ; -- 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 | ;
|
---|
58 | MG1 ; -- 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 | ;
|
---|