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