source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACNEWSV.m@ 1093

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

initial load of WorldVistAEHR

File size: 833 bytes
RevLine 
[613]1QACNEWSV ;WCIOFO/ERC-Enter a new Service/Discipline ;9/13/97
2 ;;2.0;Patient Representative;**3,5,12**;07/25/1995
3 ;This routine allows Patient Advocates to make new entries in the
4 ;Service/Discipline file (#745.55)
5 S DIC="^QA(745.55,"
6 S DIC(0)="AEL"
7 S DIC("A")="Enter a new Service/Discipline: "
8 S DLAYGO=745.55
9 D ^DIC
10 K DLAYGO
11 Q:$G(Y)<0
12 S DIE=DIC,DR=".01;1;2;3"
13 S (DA,QACDA)=+Y
14 D ^DIE
15 ; if user does not enter a Discipline, display a message and give
16 ; another chance
17 I $P(^QA(745.55,QACDA,0),U,3)']"" D
18 . W !!?5,"Service/Discipline must point to a Discipline.",!
19 . S DR="2;3" D ^DIE
20 ; if still no discipline display a message & delete Service/Discipline
21 I $P(^QA(745.55,QACDA,0),U,3)']"" D
22 . W !!?5,"No Discipline entered - deleting Service/Discipline.",!
23 . S DIK=DIE,DA=QACDA D ^DIK
24 K DA,DIC,DIE,DR,QACDA
25 Q
Note: See TracBrowser for help on using the repository browser.