| 1 | DVBCEEXM ;ALB/GTS-557/THM-COMPILE EXISTING 2507 EXAMS ; 5/24/91 7:07 AM
|
|---|
| 2 | ;;2.7;AMIE;**22**;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;only need DFN to return data
|
|---|
| 5 | I '$D(^DVB(396.4,"APE",DFN)) W !!,"No Requests are currently on file." 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 | W "Requested exams currently on file:",!!
|
|---|
| 9 | D SORT
|
|---|
| 10 | F JX=1:1:80 W "-"
|
|---|
| 11 | K DVBAEXM,DVBAEXST,DVBADA,DVBADONE,DVBAPDT,DVBAST,DVBARO,JX,DVBCX
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | STAT 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 | ;
|
|---|
| 19 | CON I $Y>12,IOST?1"C-".E W !!,"Press [RETURN] to continue or ""^"" to end display of existing exams" R ANS:DTIME W ! I '$T!(ANS=U) S DVBADONE=1
|
|---|
| 20 | I $Y>12,IOST?1"C-".E W:(DVBADONE'=1) @IOF,"Exams currently on file, continued --",!!!
|
|---|
| 21 | I ($Y>45),(IOST?1"P-".E) D HDR
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | HDR S PG=PG+1
|
|---|
| 25 | 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
|
|---|
| 26 | W ! F XLINE=1:1:80 W "="
|
|---|
| 27 | W !!,"Requested exams currently on file:",!
|
|---|
| 28 | W ! Q
|
|---|
| 29 | ;
|
|---|
| 30 | SORT ; ** Explore 396.4 file; display exams already requested **
|
|---|
| 31 | N DVBAEXM,DVBADA,DVBADONE,DVBAPDT,DVBAST,DVBARO,DVBARQDT
|
|---|
| 32 | S (DVBAEXM,DVBADA,DVBADONE,DVBAPDT,DVBAST,DVBARO,DVBARQDT)=""
|
|---|
| 33 | 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
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | FLOOP ; ** Final loop of "APE" index **
|
|---|
| 37 | F S DVBADA=$O(^DVB(396.4,"APE",DFN,DVBAEXM,DVBARQDT,DVBADA)) Q:DVBADA="" D BLD,CON Q:DVBADONE=1 D PRINT
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | BLD ; ** Set variables to be printed to screen **
|
|---|
| 41 | N DA,DIK,DATA,DVBAREQ,DVBASTAT,DVBATYPE
|
|---|
| 42 | ;don't continue if record doesn't exist in file #396.4
|
|---|
| 43 | I '$D(^DVB(396.4,DVBADA,0)) D Q
|
|---|
| 44 | .;kill xref if record doesn't exist
|
|---|
| 45 | .K ^DVB(396.4,"APE",DFN,DVBAEXM,DVBARQDT,DVBADA)
|
|---|
| 46 | ;don't continue if record doesn't exist in file #396.3
|
|---|
| 47 | S DVBAREQ=$P(^DVB(396.4,DVBADA,0),U,2) D Q:'DVBAREQ
|
|---|
| 48 | .I '$D(^DVB(396.3,DVBAREQ)) D
|
|---|
| 49 | ..;delete record in file #396.4 if its 'parent' in file #396.3 doesn't exist
|
|---|
| 50 | ..;remove reference to file #396.3 so call to ^dik won't error out
|
|---|
| 51 | ..S DATA=^DVB(396.4,DVBADA,0),$P(^(0),U,2)=""
|
|---|
| 52 | ..;delete "c" xref and mumps xrefs manually because reference to file #396.3 was removed
|
|---|
| 53 | ..S DVBATYPE=$P(DATA,U,3),DVBASTAT=$P(DATA,U,4)
|
|---|
| 54 | ..K ^DVB(396.4,"C",DVBAREQ,DVBADA)
|
|---|
| 55 | ..K ^DVB(396.4,"APE",DFN,DVBAEXM,DVBARQDT,DVBADA)
|
|---|
| 56 | ..K ^DVB(396.4,"APS",DFN,DVBATYPE,DVBASTAT,DVBADA)
|
|---|
| 57 | ..K ^DVB(396.4,"ARQ"_DVBAREQ,DVBATYPE,DVBADA)
|
|---|
| 58 | ..;proceed with fm delete
|
|---|
| 59 | ..S DIK="^DVB(396.4,",DA=DVBADA D ^DIK
|
|---|
| 60 | ..S DVBAREQ=0
|
|---|
| 61 | S Y=DVBARQDT X ^DD("DD") S DVBAPDT=Y
|
|---|
| 62 | S DVBARO=$P(^DVB(396.3,DVBAREQ,0),U,3)
|
|---|
| 63 | S DVBARO=$S($D(^DIC(4,+DVBARO,0)):$P(^(0),U,1),1:"Unknown RO")
|
|---|
| 64 | D STAT
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | PRINT ; ** Print an entry from list of requested exams **
|
|---|
| 68 | W DVBAEXM,!,"Requested on ",DVBAPDT," by ",DVBARO," - ",DVBAST,!!
|
|---|
| 69 | Q
|
|---|
