| [613] | 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 | ; | 
|---|