source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCEDIT.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1DVBCEDIT ;ALB/GTS-557/THM-EDIT 2507 DATA ; 6/19/91 1:22 PM
2 ;;2.7;AMIE;**7**;Apr 10, 1995
3 I $D(DUZ)#2=0 W *7,!!,"You have no user number.",!! Q
4 ;
5EN D HOME^%ZIS K OUT S FF=IOF,HD="Veteran Selection",HD2="2507 Exam Data Entry"
6 ;
7LOOK S %DT(0)=-DT D KILL W @FF,!?(80-$L(HD)\2),HD,!?(80-$L(HD2)\2),HD2,!!! S DIC("W")="D DICW^DVBCUTIL" S DIC="^DVB(396.3,",DIC(0)="AEQM",DIC("A")="Select VETERAN: " D ^DIC G:X=""!(X=U) EXIT I +Y<0 W " ???" H 1 G LOOK
8 S STAT=$P(^DVB(396.3,+Y,0),U,18) I STAT="N" W *7,!!,"This request has not been reported to MAS and may not be transcribed.",!! H 3 G LOOK
9 S (REQDA,DA(1))=+Y D STATCHK^DVBCUTL4 H:$D(NCN) 2 G:$D(NCN) LOOK
10 S DFN=$P(Y,U,2),REQDT=$P(^DVB(396.3,REQDA,0),U,2),PNAM=$S($D(^DPT(DFN,0)):$P(^(0),U,1),1:"Unknown"),SSN=$S($D(^(0)):$P(^(0),U,9),1:"Not specified")
11 S CNUM=$S($D(^DPT(DFN,.31)):$P(^(.31),U,3),1:"Unknown") K DICW
12 F DA=0:0 S DA=$O(^DVB(396.4,"C",REQDA,DA)) Q:DA="" S EXAM=$P(^DVB(396.4,DA,0),U,3) S EXAM=$P(^DVB(396.6,EXAM,0),U,1),STAT=$P(^DVB(396.4,DA,0),U,4),^TMP($J,EXAM)=STAT_U_DA
13 ;
14DATA K NCN,QUE D HDR^DVBCUTIL
15 W !
16 S Y=$$EXSRH^DVBCUTL4("Select Exam: ","I $D(^DVB(396.4,""ARQ""_REQDA,+Y))")
17 G:$D(DTOUT) EXIT G:X=""!(X=U) LOOK
18 I +Y<0 W *7," ???" G DATA
19 S DVBCLCKD=$$XMLCK(+Y)
20 I +DVBCLCKD'=1 W !!,*7,"This exam is currently being edited. <RETURN> to continue." R DVBCTST:DTIME K DVBCTST G DATA
21 S (EXMDA,DA)=+Y,EXMNM=$P(^DVB(396.4,+Y,0),U,3)
22 S EXMNM=$P(^DVB(396.6,EXMNM,0),U,1)
23 S STAT=$P(^TMP($J,EXMNM),U,1)
24 D STATCHK^DVBCUTL4
25 I STAT="C",$P(^DVB(396.4,EXMDA,0),U,10)]"" W !,*7,"These exam results have been electronically signed.",!,"No editing is allowed!" D CONTMES^DVBCUTL4 S DVBCLCKD=$$XMUNLCK(EXMDA) G DATA
26 W:STAT="C" "But you may make changes until it is released.",!! H:STAT="C" 2 I $D(NCN)&("^X^RX^"[STAT) S DVBCLCKD=$$XMUNLCK(EXMDA) G DATA
27 I STAT="T" W *7,!!,"This exam has been transferred to another facility.",!! H 2 S DVBCLCKD=$$XMUNLCK(EXMDA) G DATA
28 K DR S (DIC,DIE)="^DVB(396.4,",DR="W @FF;70;W @FF,!!;.06R;.07R"
29 S DA=EXMDA D ^DIE,COMP^DVBCUTL4
30 S DVBCLCKD=$$XMUNLCK(EXMDA)
31 G:$D(OUT) EXIT S STAT1=$P(^DVB(396.4,EXMDA,0),U,4),$P(^TMP($J,EXMNM),U,1)=STAT1
32 S NFINAL=0
33 F EXMDA=0:0 S EXMDA=$O(^DVB(396.4,"C",REQDA,EXMDA)) Q:EXMDA="" S STAT=$P(^DVB(396.4,EXMDA,0),U,4) I STAT'="C"&(STAT'="X")&(STAT'="RX") S NFINAL=1
34 I NFINAL=0,$P(^DVB(396.3,REQDA,0),U,12)="" S XMB="DVBA C 2507 EXAM READY",XMB(1)=PNAM,XMB(2)=SSN,Y=REQDT X ^DD("DD") S XREQDT=Y,XMB(3)=XREQDT D ^XMB K XMB,XREQDT
35 ;
36QUE K IO("Q"),%DT S QUE="N" I NFINAL=0 K DR S DIE="^DVB(396.3,",DA=REQDA,DR="11///NOW;17////T" D ^DIE S %DT(0)=-DT
37 ;
38QUE1 K IO("Q") W !!,"Do you want to print a review copy" S %=2 D YN^DICN G:$D(DTOUT) EXIT I %=1 S QUE="Y"
39 I $D(%Y),%Y["?" W !!,"Enter Y to print a copy of the results for review",!,"or N to continue editing.",!! H 2 G QUE1
40 I QUE="Y" S (DA(1),DA)=REQDA W !! S %ZIS="AEQ" D ^%ZIS K %ZIS I POP S QUE="N" K IO("Q")
41 I '$D(IO("Q")),QUE="Y" S EDPRT=1 U IO D ZTSK^DVBCPRN1 K EDPRT,AUTO,ULINE,EXMNM,XEXMNM,PGHD,DVBCSITE
42 I $D(IO("Q")) S ZTRTN="ZTSK^DVBCPRN1",ZTIO=ION,ZTDESC="2507 Review Report",ZTDTH=$H F I="DVBC*","DUZ*","DA*","REQDA","EXMNM" S ZTSAVE(I)=""
43 I $D(IO("Q")) D ^%ZTLOAD I $D(ZTSK) W !!,"2507 Request queued for review to device "_ION,!! H 2 K ZTRTN,ZTIO,ZTSAVE,ZTDTH,ZTSK,IO("Q")
44 D ^%ZISC
45 I QUE="Y" G LOOK
46 G DATA
47 ;
48EXIT K DVBCLCKD D:$D(ZTQUEUED) KILL^%ZTLOAD K WPTYPE,%DT G KILL^DVBCUTIL
49 ;
50KILL K ^TMP($J),DIC,DA,D0,D1,DFN,X,Y,OLDEXAM,REQDT,DR,EXMNM,NCN,STAT,NOFND,NFINAL,QUE,%,%Y,%ZIS,IOP
51 Q
52 ;
53XMLCK(DA) ; ** Lock the 396.4 exam record selected for transcription **
54 L +^DVB(396.4,+DA,0):1
55 Q $T
56 ;
57XMUNLCK(DA) ; ** Unlock the 396.4 exam record selected for transcription **
58 L -^DVB(396.4,DA,0)
59 Q 0
Note: See TracBrowser for help on using the repository browser.