source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCREDT.m@ 1177

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1DVBCREDT ;ALB/GTS-557/THM-EDIT STATIC C&P INFO ; 11/20/90 6:29 AM
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4 ;**Note: Priority E is Insufficient
5 ; Priority 'E is not insufficient
6 ;
7 K ^TMP("DVBCEDIT",$J) I $D(DUZ)#2=0 W !!,*7,"Your user number is invalid.",!! H 3 G EXIT
8 S LN="EDIT C&P STATIC INFORMATION" D HOME^%ZIS S FF=IOF
9 G EN1
10 ;
11COMPARE I '$D(^TMP("DVBCEDIT",$J,DA,2,I,0)) S DVBCMOD=1 Q
12 I ^DVB(396.3,DA,2,I,0)'=^TMP("DVBCEDIT",$J,DA,2,I,0) S DVBCMOD=1 Q
13 Q
14 ;
15EN1 W @IOF,!?(IOM-$L(LN)\2),LN,!!! S DIC="AE",DIC("A")="Enter VETERAN NAME: ",DIC="^DVB(396.3,",DIE=DIC,DIC(0)="AEQM" D ^DIC G:X=""!(X=U) EXIT S DA=+Y I DA<0 G EN1
16 S STAT=$P(^DVB(396.3,DA,0),U,18) I STAT'="N"&(STAT'="P") W !!,"The status of this request is not NEW or PENDING, REPORTED.",!,"It cannot, therefore, be modified.",*7,!! S DVBCMOD=1 G CON
17 F I=0:0 S I=$O(^DVB(396.3,DA,2,I)) Q:I="" S ^TMP("DVBCEDIT",$J,DA,2,I,0)=^DVB(396.3,DA,2,I,0) ;save lines for compare
18 ;
19EDIT ;
20 N DVBARQST,SAVEDA,ENTTOUT
21 S DVBARQST=$P(^DVB(396.3,DA,0),U,10)
22 S SAVEDA=DA
23 W !! S DR="W @IOF,!!;9;10:10.2;24;29;21;W !!;23" D ^DIE
24 S:$D(DTOUT) ENTTOUT=""
25 ;
26 ;**Priority E -> E
27 I DVBARQST="E",($P(^DVB(396.3,DA,0),U,10)="E"&('$D(ENTTOUT))) DO
28 .W !
29 .N UPDT2507
30 .K DTOUT,DUOUT
31 .S DIR(0)="Y^AO",DIR("A")="Do you want to change the request this insufficient is linked to"
32 .S DIR("?")="Enter Yes to change the link and No to keep the current link.",DIR("B")="NO" D ^DIR
33 .S:+Y=1 UPDT2507=""
34 .I $D(UPDT2507) DO
35 ..K DIR,Y
36 ..N REQDA S REQDA=SAVEDA
37 ..S NODE5=""
38 ..S:$D(^DVB(396.3,REQDA,5)) NODE5=^DVB(396.3,REQDA,5) ;**Save link node
39 ..D CLINSF^DVBCLOG2 S DA=SAVEDA D INSUF^DVBCLOG2 ;*Update 2507 Link info
40 ..I '$D(DVBAOUT),('$D(DUOUT)) D INSUFXM^DVBCUTA2 ;*Update exam info
41 ..I $D(DVBAOUT)!($D(DUOUT)) D RESTLINK^DVBCUTA2 ;*Restore 2507 link
42 ..K NODE5
43 .I '$D(UPDT2507) DO ;**Exam info update check
44 ..W !
45 ..N REQDA S REQDA=SAVEDA
46 ..S NODE5=^DVB(396.3,REQDA,5) ;**Save the link info node
47 ..D INSUFXM^DVBCUTA2 ;**Update exam info
48 ..K XMEDT,NODE5
49 .S DA=SAVEDA
50 ;
51 ;**Priority 'E -> E
52 I DVBARQST'="E",($P(^DVB(396.3,DA,0),U,10)="E"&('$D(ENTTOUT))) DO
53 .K DIR,Y
54 .N REQDA,XMDA S REQDA=SAVEDA
55 .D INSUF^DVBCLOG2 ;**Enter 2507 insuf link info
56 .I '$D(DVBAOUT) DO ;**Enter insuf info on exams
57 ..N EXMNM,XMSTAT
58 ..K DTOUT
59 ..F XMDA=0:0 S XMDA=$O(^DVB(396.4,"C",REQDA,XMDA)) Q:(XMDA=""!($D(DTOUT))) DO
60 ...W @IOF
61 ...D XMUPDT^DVBCUTA2 ;**Exam info
62 ..S:$D(DTOUT) DVBAOUT="" K Y,^TMP($J,"NEW")
63 .I $D(DVBAOUT) DO ;**Restore priority info when time out
64 ..N MSG,RESET,EXMCLR
65 ..S (RESET,MSG,EXMCLR)=""
66 ..D RESTORE
67 .S DA=SAVEDA
68 ;
69 ;**Priority E -> 'E
70 I DVBARQST="E",($P(^DVB(396.3,DA,0),U,10)'="E") DO
71 .N REQDA,EXMCLR S REQDA=SAVEDA S EXMCLR=""
72 .D RESTORE ;**Clear link and insuf info on exams
73 .S DA=SAVEDA
74 ;
75 ;**If Timed out of information edit in DR string
76 I $D(ENTTOUT) DO
77 .I DVBARQST'="E",($P(^DVB(396.3,DA,0),U,10)="E") DO ;**clear insf info
78 ..N REQDA,MSG,RESET
79 ..S REQDA=SAVEDA S (MSG,RESET)=""
80 ..D RESTORE
81 S DA=SAVEDA
82 S DIE="^DVB(396.3,"
83 I $P(^DVB(396.3,DA,0),U,2)[DT G CONK ;no check if entered today
84 K DVBCMOD F I=0:0 S I=$O(^DVB(396.3,DA,2,I)) Q:I="" D COMPARE Q:$D(DVBCMOD)
85 I $D(DVBCMOD) S DR="23.5///NOW;23.6////^S X=DUZ" D ^DIE W @IOF,!!,*7,"Since you have modified the REMARKS section,",!,"a new copy of the request will be issued to the",!,"medical center tomorrow morning."
86 ;
87CON I $D(DVBCMOD) W !!,"Press RETURN to continue " R ANS:DTIME G:'$T!(ANS=U) EXIT
88CONK K I,DVBCMOD,DIC,DA,DIE,X,Y G EN1
89 ;
90EXIT K ^TMP("DVBCEDIT",$J) G KILL^DVBCUTIL
91 ;
92RESTORE ;** Remove insufficient info from 2507
93 K DIE,DA,DR
94 D CLINSF^DVBCLOG2 ;**Clear 2507 info
95 I $D(RESET) DO ;**Reset Priority
96 .S DA=REQDA,DR="9////^S X=DVBARQST",DIE="^DVB(396.3,"
97 .D ^DIE K DA,DR,DIE
98 I $D(EXMCLR) DO ;**Clear exam info
99 .F XMDA=0:0 S XMDA=$O(^DVB(396.4,"C",REQDA,XMDA)) Q:(XMDA="") DO
100 ..K DA,DR,DIE
101 ..S DA=XMDA,DR=".11////@;.12///@;80///@",DIE="^DVB(396.4,"
102 ..D ^DIE
103 .K DA,DR,DIE
104 I $D(MSG) DO ;**Output message
105 .S TVAR(1,0)="1,3,0,2:1,0^Insufficient link info not updated!...Priority restored"
106 .D WR^DVBAUTL4("TVAR")
107 .K TVAR
108 .D CONTMES^DVBCUTL4
109 Q
Note: See TracBrowser for help on using the repository browser.