ORUTL1 ; slc/dcm - OE/RR Utilities ;5/30/07 13:46
;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,66,243**;Dec 17, 1997;Build 242
LOC ;Hospital Location Look-up
N DIC,ORIA,ORRA
S DIC=44,DIC(0)="AEQM",DIC("S")="I '$P($G(^(""OOS"")),""^"")"
D ^DIC
I Y<1 Q
I $D(^SC(+Y,"I")) S ORIA=+^("I"),ORRA=$P(^("I"),U,2)
I $S('$D(ORIA):0,'ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1) W $C(7),!," This location has been inactivated.",! K ORL G LOC
Q
QUE(ZTRTN,ZTDESC,ZTSAVE,ORIOPTR,ZTDTH,%ZIS,QUE,ECHO,ORION) ;Device Handling
IO ;This entry point replaced by QUE, but left for backwards compatibility
Q:'$D(ZTRTN)
N IO,ION,IOP,IOPAR,IOT,ZTSK,ZTIO,POP
I $G(QUE),'$L($G(ORIOPTR)) Q
I $L($G(ORIOPTR)),$G(QUE),$D(ORION) S ZTIO=ORION G IOQ
S:'($D(%ZIS)#2) %ZIS="Q"
I $G(QUE) S:%ZIS'["Q" %ZIS=%ZIS_"Q" S %ZIS("S")="I $S($G(^%ZIS(2,+$G(^(""SUBTYPE"")),0))'[""C-"":1,1:0)",%ZIS("B")=""
I $L($G(ORIOPTR)) S IOP=ORIOPTR
D ^%ZIS
I POP S OREND=1 Q
S ZTIO=ION
IOQ I $G(QUE)!$D(IO("Q")) D Q
. S:'$D(ZTSAVE) ZTSAVE("O*")=""
. D ^%ZTLOAD
. I $D(ZTSK),'$D(ECHO) W !,"REQUEST QUEUED"
. I '$D(ZTSK) S OREND=1
. D ^%ZISC
D @ZTRTN
D ^%ZISC
Q
;
DPI(PATCH) ;Function returns date patch installed - added in patch 243
;PATCH is set to patch designation, for example, "SR*3.0*157"
;Output is the fileman date/time that patch was installed on this system
;A return value of -1 is given if patch hasn't been installed
N ORVALUE,ORDAT,ORERR,VER,PKG,DATE,NUM
S DATE=-1
I '$$PATCH^XPDUTL(PATCH) Q DATE ;If patch hasn't been installed yet quit
S ORVALUE=$P(PATCH,"*") ;Package
D FIND^DIC(9.4,,,"MO",.ORVALUE,,,,,"ORDAT","ORERR")
S PKG=$G(ORDAT("DILIST",2,1)) I 'PKG Q DATE
S ORVALUE=$P(PATCH,"*",2) ;Version
D FIND^DIC(9.49,(","_PKG_","),,"X",.ORVALUE,,,,,"ORDAT","ORERR")
S VER=$G(ORDAT("DILIST",2,1)) I 'VER Q DATE
S ORVALUE=$P(PATCH,"*",3) ;Patch number
D FIND^DIC(9.4901,(","_VER_","_PKG_","),,,.ORVALUE,,,,,"ORDAT","ORERR")
S NUM=$G(ORDAT("DILIST",2,1)) I 'NUM Q DATE
S DATE=$$GET1^DIQ(9.4901,(NUM_","_VER_","_PKG_","),.02,"I")
Q DATE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORUTL1 2080 printed Sep 23, 2025@20:10:57 Page 2
ORUTL1 ; slc/dcm - OE/RR Utilities ;5/30/07 13:46
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,66,243**;Dec 17, 1997;Build 242
LOC ;Hospital Location Look-up
+1 NEW DIC,ORIA,ORRA
+2 SET DIC=44
SET DIC(0)="AEQM"
SET DIC("S")="I '$P($G(^(""OOS"")),""^"")"
+3 DO ^DIC
+4 IF Y<1
QUIT
+5 IF $DATA(^SC(+Y,"I"))
SET ORIA=+^("I")
SET ORRA=$PIECE(^("I"),U,2)
+6 IF $SELECT('$DATA(ORIA):0,'ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1)
WRITE $CHAR(7),!," This location has been inactivated.",!
KILL ORL
GOTO LOC
+7 QUIT
QUE(ZTRTN,ZTDESC,ZTSAVE,ORIOPTR,ZTDTH,%ZIS,QUE,ECHO,ORION) ;Device Handling
IO ;This entry point replaced by QUE, but left for backwards compatibility
+1 if '$DATA(ZTRTN)
QUIT
+2 NEW IO,ION,IOP,IOPAR,IOT,ZTSK,ZTIO,POP
+3 IF $GET(QUE)
IF '$LENGTH($GET(ORIOPTR))
QUIT
+4 IF $LENGTH($GET(ORIOPTR))
IF $GET(QUE)
IF $DATA(ORION)
SET ZTIO=ORION
GOTO IOQ
+5 if '($DATA(%ZIS)#2)
SET %ZIS="Q"
+6 IF $GET(QUE)
if %ZIS'["Q"
SET %ZIS=%ZIS_"Q"
SET %ZIS("S")="I $S($G(^%ZIS(2,+$G(^(""SUBTYPE"")),0))'[""C-"":1,1:0)"
SET %ZIS("B")=""
+7 IF $LENGTH($GET(ORIOPTR))
SET IOP=ORIOPTR
+8 DO ^%ZIS
+9 IF POP
SET OREND=1
QUIT
+10 SET ZTIO=ION
IOQ IF $GET(QUE)!$DATA(IO("Q"))
Begin DoDot:1
+1 if '$DATA(ZTSAVE)
SET ZTSAVE("O*")=""
+2 DO ^%ZTLOAD
+3 IF $DATA(ZTSK)
IF '$DATA(ECHO)
WRITE !,"REQUEST QUEUED"
+4 IF '$DATA(ZTSK)
SET OREND=1
+5 DO ^%ZISC
End DoDot:1
QUIT
+6 DO @ZTRTN
+7 DO ^%ZISC
+8 QUIT
+9 ;
DPI(PATCH) ;Function returns date patch installed - added in patch 243
+1 ;PATCH is set to patch designation, for example, "SR*3.0*157"
+2 ;Output is the fileman date/time that patch was installed on this system
+3 ;A return value of -1 is given if patch hasn't been installed
+4 NEW ORVALUE,ORDAT,ORERR,VER,PKG,DATE,NUM
+5 SET DATE=-1
+6 ;If patch hasn't been installed yet quit
IF '$$PATCH^XPDUTL(PATCH)
QUIT DATE
+7 ;Package
SET ORVALUE=$PIECE(PATCH,"*")
+8 DO FIND^DIC(9.4,,,"MO",.ORVALUE,,,,,"ORDAT","ORERR")
+9 SET PKG=$GET(ORDAT("DILIST",2,1))
IF 'PKG
QUIT DATE
+10 ;Version
SET ORVALUE=$PIECE(PATCH,"*",2)
+11 DO FIND^DIC(9.49,(","_PKG_","),,"X",.ORVALUE,,,,,"ORDAT","ORERR")
+12 SET VER=$GET(ORDAT("DILIST",2,1))
IF 'VER
QUIT DATE
+13 ;Patch number
SET ORVALUE=$PIECE(PATCH,"*",3)
+14 DO FIND^DIC(9.4901,(","_VER_","_PKG_","),,,.ORVALUE,,,,,"ORDAT","ORERR")
+15 SET NUM=$GET(ORDAT("DILIST",2,1))
IF 'NUM
QUIT DATE
+16 SET DATE=$$GET1^DIQ(9.4901,(NUM_","_VER_","_PKG_","),.02,"I")
+17 QUIT DATE
