source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCLOG2.m@ 1384

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1DVBCLOG2 ;ALB/GTS-LOG A 2507 REQUEST CONT; 11/17/94 1:30 PM
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4CLINSF ;** Reset 2507 when priority changed from Insufficient
5 S DA=REQDA,DIE="^DVB(396.3,",DR="44///@;45///@"
6 D ^DIE
7 K DA,DIE,DR,Y
8 Q
9 ;
10INSUF ;** Enter Insuffient 2507 info
11 W @IOF
12 S DVBADFN=$P(^DVB(396.3,REQDA,0),"^",1),DVBADA="",DVBASTAT="C"
13 D REQARY^DVBCUTL5 ;**Set up ^TMP of 2507's
14 I $D(^TMP("DVBC",$J)) DO REQSEL^DVBCUTL5 S DVBASEL=+Y ;** Select 2507
15 I '$D(^TMP("DVBC",$J)) S DVBASEL=0
16 I +DVBASEL>0 DO ;** Update ORIGINAL 2507 REQUEST
17 .S DVBAORD=""
18 .D FINDDA^DVBCUTL5 ;** Loop through ^TMP and get selected DA
19 .K DA,DIE,DR,Y
20 .S DA=REQDA,DIE="^DVB(396.3,",DR="44////"_DVBADA D ^DIE
21 K DA,DIE,DR,Y,DIR,X,^TMP("DVBC",$J),DVBAORD,DVBAMORE,DVBACNT,DVBALP
22 K DVBAPNAM,DVBASEL,DVBAOUT,DVBADA,DVBADFN,DVBADT,DVBADTOT
23 ;
24 ;** If 2507 not linked to completed 2507 and not time or '^' out
25 ;** when selecting 2507, enter 2507 PROCESSING TIME
26 ;** NOTE: I '$D(DVBAOUT) removed 2/3/95 because killed above
27 I $D(^DVB(396.3,REQDA,5)),(+$P(^DVB(396.3,REQDA,5),U,1)'>0) DO
28 .K DTOUT,DUOUT,Y
29 .S DA=REQDA,DIE="^DVB(396.3,"
30 .S DR="45"
31 .D ^DIE
32 .S:$D(DTOUT) DVBADTOT=""
33 .I $D(DTOUT)!($D(Y)) S DVBAOUT=""
34 I '$D(^DVB(396.3,REQDA,5)) DO
35 .K DTOUT,DUOUT,Y
36 .S DA=REQDA,DIE="^DVB(396.3,"
37 .S DR="45"
38 .D ^DIE
39 .S:$D(DTOUT) DVBADTOT=""
40 .I $D(DTOUT)!($D(Y)) S DVBAOUT=""
41 K DIE,DR,DA
42 S DA=REQDA
43 ;
44 ;**If 2507 not linked and 2507 Processing Time not entered
45 I '$D(DVBADTOT) DO
46 .I $D(^DVB(396.3,REQDA,5)),((+$P(^DVB(396.3,REQDA,5),U,1)'>0)&($P(^DVB(396.3,REQDA,5),U,2)="")) D PASS1
47 .I '$D(^DVB(396.3,REQDA,5)) D PASS1
48 K DVBADTOT
49 Q
50 ;
51PASS1 ;** Insufficient 2507 selection error on edit of newly created 2507
52 S TVAR(1,0)="0,0,0,1,0^You must either select a request to link or enter the 2507 Processing Time."
53 S TVAR(2,0)="0,0,0,1,0^Enter 0 if you don't know the processing time of the original request."
54 D WR^DVBAUTL4("TVAR")
55 K TVAR
56 S DVBAOUT=""
57 Q
Note: See TracBrowser for help on using the repository browser.