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)
Q
;
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)
Q
;
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
Q
;
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
Q
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)
