- 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 Feb 18, 2025@23:08:26 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