source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSQUED.m@ 1150

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1HLCSQUED ;ALB/MFK - Create and edit #870 entries
2 ;;1.6;HEALTH LEVEL SEVEN;;Oct 13, 1995
3EDITQ ; edit or create an entry in a queue
4 ; INPUT: NONE (made to be called from a menu)
5 ; OUTPUT: NONE
6 N DIR,DIE,DIC,DA,DR,FLAG,HLDIR,LLE,X,Y,HLZ,ENTRY,DTOUT,DUOUT
7LINK ;
8 S DIC="^HLCS(870,"
9 S DIC(0)="AEMQ"
10 D ^DIC K DIC
11 Q:(+Y<0)
12 S LLE=$P(Y,"^",1)
13 Q:(LLE=-1)
14DIRECT ;
15 S DIR(0)="S^I:IN QUEUE;O:OUT QUEUE"
16 S DIR("?")="Select the IN queue or OUT queue (relative to DHCP)"
17 S DIR("A")="Select queue"
18 S DIR("B")="I"
19 D ^DIR K DIR
20 Q:(+Y<0)!$D(DUOUT)!$D(DTOUT)
21 S HLDIR=$E(Y,1,1)
22 S HLDIR=$S(HLDIR="I":1,HLDIR="O":2)
23EDCR ;
24 S DIR(0)="S^C:CREATE;E:EDIT"
25 S DIR("?")="Select if you want to EDIT or CREATE and entry in a queue"
26 S DIR("A")="CREATE or EDIT entry"
27 S DIR("B")="C"
28 D ^DIR K DIR
29 S FLAG=$E(Y,1,1)
30 Q:(FLAG="^")!(FLAG=-1)!$D(DUOUT)!$D(DTOUT)
31 I FLAG="C" S DA=$$CREATE(LLE,HLDIR)
32 I FLAG="E" S DA=$$EDIT(LLE,HLDIR)
33 Q:(DA'>0)
34 S DIE="^HLCS(870,"_LLE_","_HLDIR_","
35 S DR="3;1;2"
36 W !,"Editing entry number: "_DA,!
37 D ^DIE K DIE
38 Q
39CREATE(LLE,HLDIR) ;
40 S ENTRY=$$ENQUEUE^HLCSQUE(LLE,HLDIR)
41 S ENTRY=$P(ENTRY,"^",2)
42 Q ENTRY
43EDIT(LLE,HLDIR) ;
44 N ENTRY
45 S ENTRY=$O(^HLCS(870,LLE,HLDIR,0))
46 I ENTRY'>0 W !,"No Entries in this Queue !" G EXED
47 S DIC="^HLCS(870,"_LLE_","_HLDIR_","
48 S DIC(0)="AEQM"
49 D ^DIC K DIC
50 S ENTRY=$P(Y,"^",1)
51EXED Q ENTRY
52EDIT2 ; Create/edit a queue in file #870
53 ; The previous routine created an entry in the queue. This
54 ; routine actually creates that queue.
55 ; INPUT: NONE (Made to be called from a menu)
56 ; OUTPUT: NONE
57 N DIC,DA,LLE,DR,DIE,X,Y
58 S DIC="^HLCS(870,"
59 S DIC(0)="AEMQL"
60 D ^DIC K DIC
61 Q:(+Y<0)
62 S LLE=$P(Y,"^",1)
63 S DR=".01;1;2;21;17;12;13;13.1;15;16"
64 S DA=LLE
65 S DIE="^HLCS(870,"
66 D ^DIE K DIE
67 Q
Note: See TracBrowser for help on using the repository browser.