|
Last change
on this file since 770 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
833 bytes
|
| Line | |
|---|
| 1 | QACNEWSV ;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.
