- 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 Feb 19, 2025@00:01:10 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