Routine: ORRCOA

ORRCOA ;SLC/JMH - ORDER ACKNOWLEDGMENT QUERY UTILITY ;  ; Compiled January 31, 2006 09:47:02

 ;;1.0;CARE MANAGEMENT;**5**;Jul 15, 2003;Build 4

INQBYORD ;

 N NUM,DIR,X,Y,LIST

 S NUM=1,LIST=""

 W !!

 W "This option searches the ORDER ACKNOWLEDGMENT file for entries related to a"

 W !,"    specific order.  This can be used to help determine if a provider"

 W !,"    has already acknowledged an order or not."

 W !!

 S DIR(0)="NO",DIR("A")="Enter an Order Number: "

 S X="" F  D ^DIR Q:'X!(X="^")  D

 .N IEN

 .S IEN=$O(^ORA(102.4,"B",X,0))

 .I 'IEN W !!,"There are no records in the ORDER ACKNOWLEDGMENT file that point to this ",!,"order number." Q

 .S LIST(IEN)=""

 Q:X="^"

 I $D(LIST)'=11 W !!,"No records have been chosen for inclusion in the report." Q

 D PRINTLST(.LIST,NUM)

INQBYPRO ;

 N I,J,NUM,LIST,DIC,X,Y,DIR,PROV,START,END

 S NUM=2,LIST="",START=0,END=9999999

 W !!

 W "This option searches the ORDER ACKNOWLEDGMENT file for un-acknowledged orders"

 W !,"    only by provider.  This can be used to help a provider identify those"

 W !,"    orders that s/he still needs to take care of."

 W !,"    Orders that have already been acknowledged will NOT show up here."

 W !!

 S DIC="^VA(200,",DIC(0)="AEQZ" D ^DIC

 I 'Y Q

 S PROV=Y

 S I=0 F  S I=$O(^ORA(102.4,"ACK",+PROV,I)) Q:'I  D

 .S J=0 F  S J=$O(^ORA(102.4,"ACK",+PROV,I,J)) Q:'J  D

 ..S LIST(J)=""

 I $D(LIST)'=11 W !!,"No records have been chosen for inclusion in the report." Q

 D PRINTLST(.LIST,NUM)

PRINTREC(IEN) ;

 N ORDER,PROV,ACKDT

 S ORDER=+$G(^ORA(102.4,IEN,0))

 S PROV=$P($G(^ORA(102.4,IEN,0)),U,2)

 S PROV=$P($G(^VA(200,PROV,0)),U)

 S ACKDT=$$FMTE^XLFDT($P($G(^ORA(102.4,IEN,0)),U,3))

 I $G(ORDER) W !!,"ORDER: ",ORDER,?35,"PROVIDER: ",PROV

 I $L($G(ACKDT)) W !,?10,"ACKNOWLEDGEMENT DATE/TIME: ",ACKDT

PRINTLST(LIST,NUM) ;

 N %ZIS

 S %ZIS="M" D ^%ZIS U IO

 N I,ORRCQ

 S ORRCQ=0

 Q:'$D(LIST)

 W @IOF

 D HDR(NUM)

 S I=0 F  S I=$O(LIST(I)) Q:'I!(ORRCQ)  D

 .D PRINTREC(I)

 .I $Y>(IOSL-3)&(IOST["C-") S ORRCQ='$$PAUSE() D

 ..Q:ORRCQ

 ..W @IOF

 ..D HDR(NUM)

 W !,"_________________________________________________",!!

 I ORRCQ W !,"Exiting report before complete..."

 I 'ORRCQ W !,"End of report."

 D ^%ZISC

HDR(NUM) ;

 I NUM=1 D

 . W !,"Listing of ORDER ACKNOWLEDGEMENTS by order number"

 . W !,"================================================="

 I NUM=2 D

 . W !,"Listing of ORDER ACKNOWLEDGMENTES by Provider"

 . W !,"============================================="

Q 0

PAUSE() ;

 N DIR,X,Y,DTOUT,DUOUT,DIRUT

 S DIR(0)="E"

 D ^DIR

 Q $S(Y'=1:0,1:1)

ORRCOA    ;SLC/JMH - ORDER ACKNOWLEDGMENT QUERY UTILITY ;  ; Compiled January 31, 2006 09:47:02

 +1       ;;1.0;CARE MANAGEMENT;**5**;Jul 15, 2003;Build 4

 +2       ;

 +3       ;

INQBYORD  ;

 +1        NEW NUM,DIR,X,Y,LIST

 +2        SET NUM=1

           SET LIST=""

 +3        WRITE !!

 +4        WRITE "This option searches the ORDER ACKNOWLEDGMENT file for entries related to a"

 +5        WRITE !,"    specific order.  This can be used to help determine if a provider"

 +6        WRITE !,"    has already acknowledged an order or not."

 +7        WRITE !!

 +8        SET DIR(0)="NO"

           SET DIR("A")="Enter an Order Number: "

 +9        SET X=""

FOR

               DO ^DIR

               IF 'X!(X="^")

                   QUIT

               Begin DoDot:1

 +10               NEW IEN

 +11               SET IEN=$ORDER(^ORA(102.4,"B",X,0))

 +12               IF 'IEN

                       WRITE !!,"There are no records in the ORDER ACKNOWLEDGMENT file that point to this ",!,"order number."

                       QUIT

 +13               SET LIST(IEN)=""

               End DoDot:1

 +14       IF X="^"

               QUIT

 +15       IF $DATA(LIST)'=11

               WRITE !!,"No records have been chosen for inclusion in the report."

               QUIT

 +16       DO PRINTLST(.LIST,NUM)

 +17       QUIT

 +18      ;

INQBYPRO  ;

 +1        NEW I,J,NUM,LIST,DIC,X,Y,DIR,PROV,START,END

 +2        SET NUM=2

           SET LIST=""

           SET START=0

           SET END=9999999

 +3        WRITE !!

 +4        WRITE "This option searches the ORDER ACKNOWLEDGMENT file for un-acknowledged orders"

 +5        WRITE !,"    only by provider.  This can be used to help a provider identify those"

 +6        WRITE !,"    orders that s/he still needs to take care of."

 +7        WRITE !,"    Orders that have already been acknowledged will NOT show up here."

 +8        WRITE !!

 +9        SET DIC="^VA(200,"

           SET DIC(0)="AEQZ"

           DO ^DIC

 +10       IF 'Y

               QUIT

 +11       SET PROV=Y

 +12       SET I=0

FOR

               SET I=$ORDER(^ORA(102.4,"ACK",+PROV,I))

               IF 'I

                   QUIT

               Begin DoDot:1

 +13               SET J=0

FOR

                       SET J=$ORDER(^ORA(102.4,"ACK",+PROV,I,J))

                       IF 'J

                           QUIT

                       Begin DoDot:2

 +14                       SET LIST(J)=""

                       End DoDot:2

               End DoDot:1

 +15       IF $DATA(LIST)'=11

               WRITE !!,"No records have been chosen for inclusion in the report."

               QUIT

 +16       DO PRINTLST(.LIST,NUM)

 +17       QUIT

 +18      ;

PRINTREC(IEN) ;

 +1        NEW ORDER,PROV,ACKDT

 +2        SET ORDER=+$GET(^ORA(102.4,IEN,0))

 +3        SET PROV=$PIECE($GET(^ORA(102.4,IEN,0)),U,2)

 +4        SET PROV=$PIECE($GET(^VA(200,PROV,0)),U)

 +5        SET ACKDT=$$FMTE^XLFDT($PIECE($GET(^ORA(102.4,IEN,0)),U,3))

 +6        IF $GET(ORDER)

               WRITE !!,"ORDER: ",ORDER,?35,"PROVIDER: ",PROV

 +7        IF $LENGTH($GET(ACKDT))

               WRITE !,?10,"ACKNOWLEDGEMENT DATE/TIME: ",ACKDT

 +8        QUIT

 +9       ;

PRINTLST(LIST,NUM) ;

 +1        NEW %ZIS

 +2        SET %ZIS="M"

           DO ^%ZIS

           USE IO

 +3        NEW I,ORRCQ

 +4        SET ORRCQ=0

 +5        IF '$DATA(LIST)

               QUIT

 +6        WRITE @IOF

 +7        DO HDR(NUM)

 +8        SET I=0

FOR

               SET I=$ORDER(LIST(I))

               IF 'I!(ORRCQ)

                   QUIT

               Begin DoDot:1

 +9                DO PRINTREC(I)

 +10               IF $Y>(IOSL-3)&(IOST["C-")

                       SET ORRCQ='$$PAUSE()

                       Begin DoDot:2

 +11                       IF ORRCQ

                               QUIT

 +12                       WRITE @IOF

 +13                       DO HDR(NUM)

                       End DoDot:2

               End DoDot:1

 +14       WRITE !,"_________________________________________________",!!

 +15       IF ORRCQ

               WRITE !,"Exiting report before complete..."

 +16       IF 'ORRCQ

               WRITE !,"End of report."

 +17       DO ^%ZISC

 +18       QUIT

HDR(NUM)  ;

 +1        IF NUM=1

               Begin DoDot:1

 +2                WRITE !,"Listing of ORDER ACKNOWLEDGEMENTS by order number"

 +3                WRITE !,"================================================="

               End DoDot:1

 +4        IF NUM=2

               Begin DoDot:1

 +5                WRITE !,"Listing of ORDER ACKNOWLEDGMENTES by Provider"

 +6                WRITE !,"============================================="

               End DoDot:1

 +7        QUIT 0

PAUSE()   ;

 +1        NEW DIR,X,Y,DTOUT,DUOUT,DIRUT

 +2        SET DIR(0)="E"

 +3        DO ^DIR

 +4        QUIT $SELECT(Y'=1:0,1:1)

ORRCOA.m