Routine: ORY124

ORY124 ;SLC/DAN--Find potentially erroneous complex orders ;10/25/01  14:36

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**124**;Dec 17, 1997

 N DIC,X,Y,ORMSG,QUE,ORIOPTR,ORION,OREND,%ZIS

 I '$G(XPDENV)!($G(^XTMP("ORY124",0))) Q  ;Don't process if just loading distribution

 D CHECK Q:Y=-1

 S ORMSG(1)="A check will now be made to identify any complex pharmacy orders that have",ORMSG(2)="exactly 4 lines associated with them.  You should review each entry",ORMSG(3)="for accuracy."

 S ORMSG(4)="",ORMSG(5)="This report will be automatically queued to run in the background.",ORMSG(6)="Please select a printer.",ORMSG(7)=""

 D MES^XPDUTL(.ORMSG)

 S QUE=1

TASK ;

 S %ZIS="Q",%ZIS("B")="" S:$G(QUE) %ZIS("S")="I $G(^(""TYPE""))'=""VTRM""" D ^%ZIS I POP D EXIT Q

 I $G(QUE)!($D(IO("Q"))) S ZTRTN="DQ^ORY124",ZTDESC="Complex orders search",ZTSAVE("*")="" D ^%ZTLOAD D:'$D(ZTSK) EXIT Q

DQ ;Come here to start

 N ORID,ORIEN,DIC,X,Y

 K ^TMP($J,"FC")

 D CHECK Q:Y=-1

 U IO W:$E(IOST,1,2)="C-" !,"Searching..."

 S ORID=Y ;Install completion date

 S ORID=$$FMADD^XLFDT(ORID\1,-1,,,-1) ;Set start date to install date - 1 day and 1 second

 S ORIEN=$O(^OR(100,"AF",+$O(^OR(100,"AF",ORID)),0)) I ORIEN="" D PRINT Q  ;Get first order number associated with date of install

 F  S ORIEN=$O(^OR(100,ORIEN)) Q:'+ORIEN  D

 .Q:$$NMSP^ORCD($P($G(^OR(100,ORIEN,0)),"^",14))'="PS"  ;Quit if not a pharmacy order

 .Q:$$DOSE'=4  ;Quit if not 4 doses

 .S ^TMP($J,"FC",ORIEN)="" ;Save if pharmacy order with 4 doses

 D PRINT,^%ZISC

 S ^XTMP("ORY124",0)=$$FMADD^XLFDT(DT,60) ;Set automatic removal to 60 days.

DOSE() ;Returns number of doses associated with order

 N DOSE,I

 F I=0:0 S I=$O(^OR(100,ORIEN,4.5,"ID","DOSE",I)) Q:'+I  S DOSE=$G(DOSE)+1

 Q +$G(DOSE)

PRINT ;Print out info associated with order

 N PAGE,DATE,J

 S PAGE=1,DATE=$$FMTE^XLFDT(DT,"2D")

 D HDR

 I '$D(^TMP($J,"FC")) W "NO DATA TO REPORT." Q

 S J=0 F  S J=$O(^TMP($J,"FC",J)) Q:'+J  D

 .W !,J

 .W ?12,$$FMTE^XLFDT($P($G(^OR(100,J,8,1,0)),"^"),"2D")

 .W ?25,$$PNM(J)

 .W ?58,$P($$STATUS^ORQOR2(J),"^",2)

 .D:$Y>(IOSL-4) HDR

HDR ;

 N DASH

 K DASH

 W @IOF,!

 W "Complex Orders Search",?35,DATE,?70,"PAGE: ",PAGE,!

 W "ORDER #",?12,"ORDER DATE",?25,"PATIENT NAME",?58,"ORDER STATUS"

 S $P(DASH,"-",IOM)="" W !,DASH,!

 S PAGE=PAGE+1

PNM(ORIEN) ;Returns patient name

 N OBJ,FILE,NAME

 S OBJ=$P($G(^OR(100,ORIEN,0)),"^",2)

 I OBJ="" Q ""

 S FILE="^"_$P(OBJ,";",2)

 S NAME=$P($G(@(FILE_$P(OBJ,";")_",0)")),"^")

 Q NAME

EXIT ;

 D BMES^XPDUTL("Report not queued.  Please run TASK^ORY124 at a later time to see the report.") Q

CHECK ;Check for patch 94 existence

 N IEN

 S Y=-1,IEN=0 F  S IEN=$O(^XPD(9.7,"B","OR*3.0*94",IEN)) Q:'+IEN  I $P($G(^XPD(9.7,IEN,1)),"^",3)'="" S Y=$P(^(1),"^",3) Q  ;Get install date from earliest entry

 I Y=-1 D BMES^XPDUTL("Patch 94 not installed, complex orders report does not need to run.") Q

ORY124    ;SLC/DAN--Find potentially erroneous complex orders ;10/25/01  14:36

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**124**;Dec 17, 1997

 +2       ;

 +3        NEW DIC,X,Y,ORMSG,QUE,ORIOPTR,ORION,OREND,%ZIS

 +4       ;Don't process if just loading distribution

           IF '$GET(XPDENV)!($GET(^XTMP("ORY124",0)))

               QUIT

 +5        DO CHECK

           IF Y=-1

               QUIT

 +6        SET ORMSG(1)="A check will now be made to identify any complex pharmacy orders that have"

           SET ORMSG(2)="exactly 4 lines associated with them.  You should review each entry"

           SET ORMSG(3)="for accuracy."

 +7        SET ORMSG(4)=""

           SET ORMSG(5)="This report will be automatically queued to run in the background."

           SET ORMSG(6)="Please select a printer."

           SET ORMSG(7)=""

 +8        DO MES^XPDUTL(.ORMSG)

 +9        SET QUE=1

TASK      ;

 +1        SET %ZIS="Q"

           SET %ZIS("B")=""

           IF $GET(QUE)

               SET %ZIS("S")="I $G(^(""TYPE""))'=""VTRM"""

           DO ^%ZIS

           IF POP

               DO EXIT

               QUIT

 +2        IF $GET(QUE)!($DATA(IO("Q")))

               SET ZTRTN="DQ^ORY124"

               SET ZTDESC="Complex orders search"

               SET ZTSAVE("*")=""

               DO ^%ZTLOAD

               IF '$DATA(ZTSK)

                   DO EXIT

               QUIT

DQ        ;Come here to start

 +1        NEW ORID,ORIEN,DIC,X,Y

 +2        KILL ^TMP($JOB,"FC")

 +3        DO CHECK

           IF Y=-1

               QUIT

 +4        USE IO

           IF $EXTRACT(IOST,1,2)="C-"

               WRITE !,"Searching..."

 +5       ;Install completion date

           SET ORID=Y

 +6       ;Set start date to install date - 1 day and 1 second

           SET ORID=$$FMADD^XLFDT(ORID\1,-1,,,-1)

 +7       ;Get first order number associated with date of install

           SET ORIEN=$ORDER(^OR(100,"AF",+$ORDER(^OR(100,"AF",ORID)),0))

           IF ORIEN=""

               DO PRINT

               QUIT

 +8        FOR

               SET ORIEN=$ORDER(^OR(100,ORIEN))

               IF '+ORIEN

                   QUIT

               Begin DoDot:1

 +9       ;Quit if not a pharmacy order

                   IF $$NMSP^ORCD($PIECE($GET(^OR(100,ORIEN,0)),"^",14))'="PS"

                       QUIT

 +10      ;Quit if not 4 doses

                   IF $$DOSE'=4

                       QUIT

 +11      ;Save if pharmacy order with 4 doses

                   SET ^TMP($JOB,"FC",ORIEN)=""

               End DoDot:1

 +12       DO PRINT

           DO ^%ZISC

 +13      ;Set automatic removal to 60 days.

           SET ^XTMP("ORY124",0)=$$FMADD^XLFDT(DT,60)

 +14       QUIT

 +15      ;

DOSE()    ;Returns number of doses associated with order

 +1        NEW DOSE,I

 +2        FOR I=0:0

               SET I=$ORDER(^OR(100,ORIEN,4.5,"ID","DOSE",I))

               IF '+I

                   QUIT

               SET DOSE=$GET(DOSE)+1

 +3        QUIT +$GET(DOSE)

 +4       ;

PRINT     ;Print out info associated with order

 +1        NEW PAGE,DATE,J

 +2        SET PAGE=1

           SET DATE=$$FMTE^XLFDT(DT,"2D")

 +3        DO HDR

 +4        IF '$DATA(^TMP($JOB,"FC"))

               WRITE "NO DATA TO REPORT."

               QUIT

 +5        SET J=0

FOR

               SET J=$ORDER(^TMP($JOB,"FC",J))

               IF '+J

                   QUIT

               Begin DoDot:1

 +6                WRITE !,J

 +7                WRITE ?12,$$FMTE^XLFDT($PIECE($GET(^OR(100,J,8,1,0)),"^"),"2D")

 +8                WRITE ?25,$$PNM(J)

 +9                WRITE ?58,$PIECE($$STATUS^ORQOR2(J),"^",2)

 +10               IF $Y>(IOSL-4)

                       DO HDR

               End DoDot:1

 +11       QUIT

 +12      ;

HDR       ;

 +1        NEW DASH

 +2        KILL DASH

 +3        WRITE @IOF,!

 +4        WRITE "Complex Orders Search",?35,DATE,?70,"PAGE: ",PAGE,!

 +5        WRITE "ORDER #",?12,"ORDER DATE",?25,"PATIENT NAME",?58,"ORDER STATUS"

 +6        SET $PIECE(DASH,"-",IOM)=""

           WRITE !,DASH,!

 +7        SET PAGE=PAGE+1

 +8        QUIT

 +9       ;

PNM(ORIEN) ;Returns patient name

 +1        NEW OBJ,FILE,NAME

 +2        SET OBJ=$PIECE($GET(^OR(100,ORIEN,0)),"^",2)

 +3        IF OBJ=""

               QUIT ""

 +4        SET FILE="^"_$PIECE(OBJ,";",2)

 +5        SET NAME=$PIECE($GET(@(FILE_$PIECE(OBJ,";")_",0)")),"^")

 +6        QUIT NAME

 +7       ;

EXIT      ;

 +1        DO BMES^XPDUTL("Report not queued.  Please run TASK^ORY124 at a later time to see the report.")

           QUIT

 +2       ;

CHECK     ;Check for patch 94 existence

 +1        NEW IEN

 +2       ;Get install date from earliest entry

           SET Y=-1

           SET IEN=0

FOR

               SET IEN=$ORDER(^XPD(9.7,"B","OR*3.0*94",IEN))

               IF '+IEN

                   QUIT

               IF $PIECE($GET(^XPD(9.7,IEN,1)),"^",3)'=""

                   SET Y=$PIECE(^(1),"^",3)

                   QUIT

 +3        IF Y=-1

               DO BMES^XPDUTL("Patch 94 not installed, complex orders report does not need to run.")

               QUIT

ORY124.m