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

DVBAREQ1.m

Go to the documentation of this file.
  1. DVBAREQ1 ;ALB/GTS-557/THM-AMIE NEW REQUESTS; 21 JUL 89@0128
  1. ;;2.7;AMIE;;Apr 10, 1995
  1. ;
  1. D INIT
  1. S DVBSEL=$$SELECT^DVBAUTL5("Date Range","7131 Request")
  1. I DVBSEL="D" D BYDATE
  1. I DVBSEL="N" D BYNAME
  1. D KILL^DVBAREQS
  1. Q
  1. ;
  1. BYDATE ;Selection by the date like old way
  1. F DO Q:DVBOUT
  1. .S DVBSTOP=0,DVBOUT=0
  1. .D KILL1^DVBAREQS
  1. .D LINE
  1. .D REMOTE
  1. .I DVBOUT Q
  1. .D DATE
  1. .I DVBOUT Q
  1. .S DVBVER=$$VERSION^DVBAREQS()
  1. .I DVBVER=0 S DVBOUT=1 Q
  1. .I DVBVER="S" D ^DVBAREQS Q
  1. .D DEVICE
  1. .I DVBOUT!(DVBSTOP) Q
  1. .I DVBVER="L" DO
  1. ..D GO
  1. ..D EXIT
  1. ..Q
  1. .Q
  1. Q
  1. ;
  1. BYNAME ;Selection by patient name
  1. F DO Q:DVBOUT
  1. .S DVBSTOP=0,DVBOUT=0
  1. .D KILL1^DVBAREQS
  1. .D LINE
  1. .S DVBDA=$$PAT^DVBAUTL5(7131)
  1. .S XDIV="ALL"
  1. .I DVBDA<0!('DVBDA) S DVBOUT=1 Q
  1. .S DVBVER=$$VERSION^DVBAREQS()
  1. .I DVBVER=0 S DVBOUT=1 Q
  1. .I DVBVER="S" DO
  1. ..S DA=DVBDA
  1. ..D NAME^DVBAREQS
  1. ..Q
  1. .I DVBVER="L" DO
  1. ..S DVBDA=+DVBDA
  1. ..S (BDT,EDT)=""
  1. ..D DEVICE
  1. ..I DVBOUT!(DVBSTOP) Q
  1. ..S QQ=1,NODTA=0,DA=+DVBDA U IO
  1. ..D PRINT^DVBAREQ3
  1. ..D EXIT
  1. ..Q
  1. .Q
  1. Q
  1. ;
  1. LINE ;LINE FEED
  1. S VAR(1,0)="0,0,0,3,0^"
  1. D WR^DVBAUTL4("VAR")
  1. K VAR
  1. Q
  1. ;
  1. REMOTE ;Get remote site name from user
  1. S XDIV=""
  1. S VAR(1,0)="0,0,0,2,0^"
  1. D WR^DVBAUTL4("VAR")
  1. K VAR
  1. S DIC("A")="For REMOTE SITE (Press RETURN for all sites) : ",DIC(0)="AEQM",DIC="^DG(40.8,"
  1. D ^DIC
  1. I $D(DTOUT)!(X=U) S DVBOUT=1 Q
  1. I +Y>0 S XDIV=+Y
  1. ASK I +Y<0 DO
  1. .S DIR(0)="YA"
  1. .S DIR("A")="Are you sure you want ALL REMOTE SITES: "
  1. .S DIR("B")="NO"
  1. .S DIR("?")="Enter Y to get all remote sites N for just one"
  1. .D ^DIR
  1. .I $D(DTOUT)!($D(DUOUT)) S DVBOUT=1 Q
  1. .I Y=1 S XDIV="ALL"
  1. .I Y=0 S VAR=1
  1. .Q
  1. I $D(VAR) G REMOTE
  1. K VAR,DIR
  1. Q
  1. ;
  1. DATE ;Gets beginning and ending dates from user
  1. S VAR(1,0)="0,0,0,1,0^"
  1. D WR^DVBAUTL4("VAR")
  1. K VAR
  1. S %DT(0)=-DT,%DT("A")="BEGINNING date: ",%DT="AE"
  1. D ^%DT
  1. I X="^"!(Y=-1) S DVBOUT=1 Q
  1. S BDT=Y
  1. S %DT("A")=" ENDING date: "
  1. D ^%DT
  1. I X="^"!(Y=-1) S DVBOUT=1 Q
  1. S EDT=Y_".2359"
  1. I EDT<BDT DO G DATE
  1. .S VAR(1,0)="1,0,0,2:2,0^Invalid dates! Ending must not be before beginning."
  1. .D WR^DVBAUTL4("VAR")
  1. .K VAR
  1. .D PAUSE^DVBCUTL4
  1. .Q
  1. K %DT
  1. Q
  1. ;
  1. GO D STM^DVBCUTL4
  1. S QQ=1,NODTA=0 U IO
  1. ;
  1. DATA S MA=BDT-.5 F J=0:0 S MA=$O(^DVB(396,"AE",MA)) Q:MA>EDT!(MA="") S:XDIV'="ALL" LPDIV=+XDIV-1 S:XDIV="ALL" LPDIV="" DO LOOPDIV
  1. D EXIT
  1. Q
  1. ;
  1. LOOPDIV ;** Loop through Division - 'AE' X-ref
  1. F LPVAR=0:0 S LPDIV=$O(^DVB(396,"AE",MA,LPDIV)) Q:(LPDIV=""!(XDIV'="ALL"&(XDIV'=LPDIV))) D LOOPDA
  1. K LPVAR
  1. Q
  1. ;
  1. LOOPDA ;** Loop through DA - 'AE' X-ref
  1. F DA=0:0 S DA=$O(^DVB(396,"AE",MA,LPDIV,DA)) Q:DA="" DO
  1. .I $D(DVBATASK) D:'$D(^TMP($J,LPDIV,DA)) PRINT^DVBAREQ3 S QQ=1
  1. .I '$D(DVBATASK) D:'$D(^TMP($J,DA)) PRINT^DVBAREQ3 S QQ=1
  1. Q
  1. ;
  1. EXIT I NODTA=0 DO
  1. .U IO
  1. .I IOST?1"C-".E S VAR(1,0)="0,0,0,0,1^" D WR^DVBAUTL4("VAR") K VAR
  1. .S VAR(1,0)="0,0,0,3,0^Notice to MAS on "_FDT(0)
  1. .S VAR(2,0)="0,0,0,1,0^There were no new 7131 requests"
  1. .S VAR(3,0)="0,0,0,1:3,0^"_$S(XDIV'="ALL":"for "_$P(^DG(40.8,XDIV,0),U,1)_" ",1:"")
  1. .I BDT]"" DO
  1. ..S Y=$P(BDT,".",1)
  1. ..X ^DD("DD")
  1. ..S VAR(3,0)=VAR(3,0)_"from "_Y_" to "
  1. ..S Y=$P(EDT,".",1)
  1. ..X ^DD("DD")
  1. ..S VAR(3,0)=VAR(3,0)_Y
  1. ..Q
  1. .D WR^DVBAUTL4("VAR")
  1. .K VAR
  1. .Q
  1. D ^%ZISC
  1. Q
  1. ;
  1. TASK S X="T-1" D ^%DT S BDT=Y
  1. S X="T-1" D ^%DT S EDT=Y_".2359"
  1. S Y=DT X ^DD("DD") S FDT(0)=Y
  1. D NOPARM^DVBAUTL2
  1. I $D(DVBAQUIT) D KILL^DVBAREQS Q
  1. S DVBSEL="D",DVBATASK=""
  1. S HOSP=$$SITE^DVBCUTL4
  1. F ZI=0:0 S ZI=$O(^DVB(396.1,1,2,"B",ZI)) Q:ZI="" F ZJ=0:0 S ZJ=$O(^DVB(396.1,1,2,"B",ZI,ZJ)) Q:ZJ="" D CLIN
  1. D KILL^DVBAREQS
  1. Q
  1. ;
  1. DEQUE Q:'$D(XDIV)
  1. I DVBSEL="D" D GO
  1. I DVBSEL="N" DO
  1. .S DA=DVBDA,QQ=1,NODTA=0
  1. .D PRINT^DVBAREQ3
  1. .D EXIT
  1. .Q
  1. D KILL^DVBAREQS
  1. Q
  1. ;
  1. CLIN ;Logic not changed, it is the original - needs to be
  1. ;looked at for efficiency
  1. S XDIV=ZI,ZTRTN="GO^DVBAREQ1",ZTIO=$P(^DVB(396.1,1,2,ZJ,0),U,2),ZTDESC="AMIE New Req for "_$S($D(^DG(40.8,XDIV,0)):$P(^(0),U,1),1:"Unknown")
  1. F I="DVBATASK","DVBSEL","FDT(0)","XDIV","BDT","EDT","HOSP" S ZTSAVE(I)=""
  1. S ZTDTH=$H D ^%ZTLOAD
  1. Q
  1. ;
  1. INIT ;Initialize variables
  1. S DVBOUT=0
  1. D NOPARM^DVBAUTL2
  1. I $D(DVBAQUIT) S DVBOUT=1
  1. D HOME^%ZIS
  1. D HDR
  1. S DVBAMAN=""
  1. S HOSP=$$SITE^DVBCUTL4
  1. S Y=DT X ^DD("DD") S FDT(0)=Y
  1. K NOASK
  1. Q
  1. ;
  1. HDR ;Writes header info
  1. S VAR(1,0)="0,0,0,1:3,1^AMIE New Request Report"
  1. D WR^DVBAUTL4("VAR")
  1. K VAR
  1. Q
  1. ;
  1. DEVICE ;Get device to print to
  1. S VAR(1,0)="0,0,0,1,0^"
  1. D WR^DVBAUTL4("VAR")
  1. K VAR
  1. S %ZIS="Q"
  1. D ^%ZIS
  1. K %ZIS
  1. I POP S DVBOUT=1 Q
  1. I $D(IO("Q")) DO
  1. .S NOASK=1,DVBSTOP=1
  1. .S ZTRTN="DEQUE^DVBAREQ1"
  1. .S ZTIO=ION,ZTDESC="Amie new request rpt"
  1. .F I="DVBSEL","DVBDA","FDT(0)","XDIV","BDT","EDT","VER","NOASK","HOSP","DVBAMAN" S ZTSAVE(I)=""
  1. .D ^%ZTLOAD
  1. .D ^%ZISC
  1. .I $D(ZTSK) DO
  1. ..S VAR(1,0)="0,0,0,2:2,0^Request queued."
  1. ..D WR^DVBAUTL4("VAR")
  1. ..K VAR
  1. ..Q
  1. .Q