source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAB68.m@ 724

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1DVBAB68 ;ALB/SPH - CAPRI C&P EXAM DETAIL REPORT ;09/11/00
2 ;;2.7;AMIE;**35**;Apr 10, 1995
3 ;
4EN ;only need DFN to return data
5 I '$D(^DVB(396.4,"APE",DFN)) S ZMSG(DVBABCNT)="No Requests are currently on file.",DVBABCNT=DVBABCNT+1 Q
6 ;;;I '$D(^DVB(396.4,"APE",DFN)) W !!,"Press [RETURN] to continue"
7 ;;;I '$D(^DVB(396.4,"APE",DFN)) R DVBCIN:DTIME K DVBCIN Q
8 S ZMSG(DVBABCNT)="Requested exams currently on file:",DVBABCNT=DVBABCNT+1
9 D SORT
10 S ZMSG(DVBABCNT)="--------------------------------------------------------------------------------",DVBABCNT=DVBABCNT+1
11 K DVBAEXM,DVBAEXST,DVBADA,DVBADONE,DVBAPDT,DVBAST,DVBARO,JX,DVBCX
12 Q
13 ;
14STAT S DVBAST=$P(^DVB(396.4,DVBADA,0),U,4)
15 S:$D(^DVB(396.4,DVBADA,"TRAN")) DVBCX=$P(^("TRAN"),U,3)
16 S DVBAST=$S(DVBAST="C":"Completed",DVBAST="RX":"Cancelled by RO",DVBAST="X":"Cancelled by MAS",DVBAST="F":"Cancelled, failed to report",DVBAST="O":"Open",DVBAST="T":"Transferred",1:"Unknown status")
17 Q
18 ;
19CON I $Y>12,IOST?1"C-".E W !
20 ;!,"Press [RETURN] to continue or ""^"" to end display of existing exams" R ANS:DTIME W ! I '$T!(ANS=U) S DVBADONE=1
21 I $Y>12,IOST?1"C-".E ;W:(DVBADONE'=1) @IOF,"Exams currently on file, continued --",!!!
22 I ($Y>45),(IOST?1"P-".E) D HDR
23 Q
24 ;
25HDR S PG=PG+1
26 W @IOF,!,"Date: ",FDT(0),?(80-$L(PGHD)\2),PGHD,?71,"Page: ",PG,!,?(80-$L($$SITE^DVBCUTL4)\2),$$SITE^DVBCUTL4 I PG>1 W !!,"Name: ",PNAM,?44,"SSN: ",SSN,?63,"C-NUM: ",CNUM
27 W ! F XLINE=1:1:80 W "="
28 W !!,"Requested exams currently on file:",!
29 W ! Q
30 ;
31SORT ; ** Explore 396.4 file; display exams already requested **
32 N DVBAEXM,DVBADA,DVBADONE,DVBAPDT,DVBAST,DVBARO,DVBARQDT
33 S (DVBAEXM,DVBADA,DVBADONE,DVBAPDT,DVBAST,DVBARO,DVBARQDT)=""
34 F S DVBAEXM=$O(^DVB(396.4,"APE",DFN,DVBAEXM)) Q:DVBAEXM=""!(DVBADONE=1) F S DVBARQDT=$O(^DVB(396.4,"APE",DFN,DVBAEXM,DVBARQDT)) Q:DVBARQDT="" D FLOOP Q:DVBADONE=1
35 Q
36 ;
37FLOOP ; ** Final loop of "APE" index **
38 F S DVBADA=$O(^DVB(396.4,"APE",DFN,DVBAEXM,DVBARQDT,DVBADA)) Q:DVBADA="" D BLD,CON Q:DVBADONE=1 D PRINT
39 Q
40 ;
41BLD ; ** Set variables to be printed to screen **
42 N DA,DIK,DATA,DVBAREQ,DVBASTAT,DVBATYPE
43 ;don't continue if record doesn't exist in file #396.4
44 I '$D(^DVB(396.4,DVBADA,0)) D Q
45 .;kill xref if record doesn't exist
46 .K ^DVB(396.4,"APE",DFN,DVBAEXM,DVBARQDT,DVBADA)
47 ;don't continue if record doesn't exist in file #396.3
48 S DVBAREQ=$P(^DVB(396.4,DVBADA,0),U,2) D Q:'DVBAREQ
49 .I '$D(^DVB(396.3,DVBAREQ)) D
50 ..;delete record in file #396.4 if its 'parent' in file #396.3 doesn't exist
51 ..;remove reference to file #396.3 so call to ^dik won't error out
52 ..S DATA=^DVB(396.4,DVBADA,0),$P(^(0),U,2)=""
53 ..;delete "c" xref and mumps xrefs manually because reference to file #396.3 was removed
54 ..S DVBATYPE=$P(DATA,U,3),DVBASTAT=$P(DATA,U,4)
55 ..K ^DVB(396.4,"C",DVBAREQ,DVBADA)
56 ..K ^DVB(396.4,"APE",DFN,DVBAEXM,DVBARQDT,DVBADA)
57 ..K ^DVB(396.4,"APS",DFN,DVBATYPE,DVBASTAT,DVBADA)
58 ..K ^DVB(396.4,"ARQ"_DVBAREQ,DVBATYPE,DVBADA)
59 ..;proceed with fm delete
60 ..S DIK="^DVB(396.4,",DA=DVBADA D ^DIK
61 ..S DVBAREQ=0
62 S Y=DVBARQDT X ^DD("DD") S DVBAPDT=Y
63 S DVBARO=$P(^DVB(396.3,DVBAREQ,0),U,3)
64 S DVBARO=$S($D(^DIC(4,+DVBARO,0)):$P(^(0),U,1),1:"Unknown RO")
65 D STAT
66 Q
67 ;
68PRINT ; ** Print an entry from list of requested exams **
69 S ZMSG(DVBABCNT)=DVBAEXM,DVBABCNT=DVBABCNT+1
70 S ZMSG(DVBABCNT)="Requested on "_DVBAPDT_" by "_DVBARO_" - "_DVBAST,DVBABCNT=DVBABCNT+1
71 S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
72 Q
Note: See TracBrowser for help on using the repository browser.