Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBAB68

DVBAB68.m

Go to the documentation of this file.
  1. DVBAB68 ;ALB/SPH - CAPRI C&P EXAM DETAIL REPORT ;09/11/00
  1. ;;2.7;AMIE;**35,149**;Apr 10, 1995;Build 16
  1. ;
  1. EN ;only need DFN to return data
  1. I '$D(^DVB(396.4,"APE",DFN)) S ZMSG(DVBABCNT)="No Requests are currently on file.",DVBABCNT=DVBABCNT+1 Q
  1. S ZMSG(DVBABCNT)="Requested exams currently on file:",DVBABCNT=DVBABCNT+1
  1. D SORT
  1. S ZMSG(DVBABCNT)="--------------------------------------------------------------------------------",DVBABCNT=DVBABCNT+1
  1. K DVBAEXM,DVBAEXST,DVBADA,DVBADONE,DVBAPDT,DVBAST,DVBARO,JX,DVBCX
  1. Q
  1. ;
  1. STAT S DVBAST=$P(^DVB(396.4,DVBADA,0),U,4)
  1. S:$D(^DVB(396.4,DVBADA,"TRAN")) DVBCX=$P(^("TRAN"),U,3)
  1. 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")
  1. Q
  1. ;
  1. SORT ; ** Explore 396.4 file; display exams already requested **
  1. N DVBAEXM,DVBADA,DVBADONE,DVBAPDT,DVBAST,DVBARO,DVBARQDT
  1. S (DVBAEXM,DVBADA,DVBADONE,DVBAPDT,DVBAST,DVBARO,DVBARQDT)=""
  1. 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
  1. Q
  1. ;
  1. FLOOP ; ** Final loop of "APE" index **
  1. F S DVBADA=$O(^DVB(396.4,"APE",DFN,DVBAEXM,DVBARQDT,DVBADA)) Q:DVBADA="" D BLD Q:DVBADONE=1 D PRINT
  1. Q
  1. ;
  1. BLD ; ** Set variables to be printed to screen **
  1. N DA,DIK,DATA,DVBAREQ,DVBASTAT,DVBATYPE
  1. ;don't continue if record doesn't exist in file #396.4
  1. I '$D(^DVB(396.4,DVBADA,0)) D Q
  1. .;kill xref if record doesn't exist
  1. .K ^DVB(396.4,"APE",DFN,DVBAEXM,DVBARQDT,DVBADA)
  1. ;don't continue if record doesn't exist in file #396.3
  1. S DVBAREQ=$P(^DVB(396.4,DVBADA,0),U,2) D Q:'DVBAREQ
  1. .I '$D(^DVB(396.3,DVBAREQ)) D
  1. ..;delete record in file #396.4 if its 'parent' in file #396.3 doesn't exist
  1. ..;remove reference to file #396.3 so call to ^dik won't error out
  1. ..S DATA=^DVB(396.4,DVBADA,0),$P(^(0),U,2)=""
  1. ..;delete "c" xref and mumps xrefs manually because reference to file #396.3 was removed
  1. ..S DVBATYPE=$P(DATA,U,3),DVBASTAT=$P(DATA,U,4)
  1. ..K ^DVB(396.4,"C",DVBAREQ,DVBADA)
  1. ..K ^DVB(396.4,"APE",DFN,DVBAEXM,DVBARQDT,DVBADA)
  1. ..K ^DVB(396.4,"APS",DFN,DVBATYPE,DVBASTAT,DVBADA)
  1. ..K ^DVB(396.4,"ARQ"_DVBAREQ,DVBATYPE,DVBADA)
  1. ..;proceed with fm delete
  1. ..S DIK="^DVB(396.4,",DA=DVBADA D ^DIK
  1. ..S DVBAREQ=0
  1. S Y=DVBARQDT X ^DD("DD") S DVBAPDT=Y
  1. S DVBARO=$P(^DVB(396.3,DVBAREQ,0),U,3)
  1. S DVBARO=$S($D(^DIC(4,+DVBARO,0)):$P(^(0),U,1),1:"Unknown RO")
  1. D STAT
  1. Q
  1. ;
  1. PRINT ; ** Print an entry from list of requested exams **
  1. S ZMSG(DVBABCNT)=DVBAEXM,DVBABCNT=DVBABCNT+1
  1. S ZMSG(DVBABCNT)="Requested on "_DVBAPDT_" by "_DVBARO_" - "_DVBAST,DVBABCNT=DVBABCNT+1
  1. S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
  1. Q