ORUTL1.m

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

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