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