| 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 | ; | 
|---|