source: FOIAVistA/trunk/r/CARE_MANAGEMENT-ORRC/ORRCOA.m@ 1458

Last change on this file since 1458 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1ORRCOA ;SLC/JMH - ORDER ACKNOWLEDGMENT QUERY UTILITY ; ; Compiled January 31, 2006 09:47:02
2 ;;1.0;CARE MANAGEMENT;**5**;Jul 15, 2003;Build 4
3 ;
4 ;
5INQBYORD ;
6 N NUM,DIR,X,Y,LIST
7 S NUM=1,LIST=""
8 W !!
9 W "This option searches the ORDER ACKNOWLEDGMENT file for entries related to a"
10 W !," specific order. This can be used to help determine if a provider"
11 W !," has already acknowledged an order or not."
12 W !!
13 S DIR(0)="NO",DIR("A")="Enter an Order Number: "
14 S X="" F D ^DIR Q:'X!(X="^") D
15 .N IEN
16 .S IEN=$O(^ORA(102.4,"B",X,0))
17 .I 'IEN W !!,"There are no records in the ORDER ACKNOWLEDGMENT file that point to this ",!,"order number." Q
18 .S LIST(IEN)=""
19 Q:X="^"
20 I $D(LIST)'=11 W !!,"No records have been chosen for inclusion in the report." Q
21 D PRINTLST(.LIST,NUM)
22 Q
23 ;
24INQBYPRO ;
25 N I,J,NUM,LIST,DIC,X,Y,DIR,PROV,START,END
26 S NUM=2,LIST="",START=0,END=9999999
27 W !!
28 W "This option searches the ORDER ACKNOWLEDGMENT file for un-acknowledged orders"
29 W !," only by provider. This can be used to help a provider identify those"
30 W !," orders that s/he still needs to take care of."
31 W !," Orders that have already been acknowledged will NOT show up here."
32 W !!
33 S DIC="^VA(200,",DIC(0)="AEQZ" D ^DIC
34 I 'Y Q
35 S PROV=Y
36 S I=0 F S I=$O(^ORA(102.4,"ACK",+PROV,I)) Q:'I D
37 .S J=0 F S J=$O(^ORA(102.4,"ACK",+PROV,I,J)) Q:'J D
38 ..S LIST(J)=""
39 I $D(LIST)'=11 W !!,"No records have been chosen for inclusion in the report." Q
40 D PRINTLST(.LIST,NUM)
41 Q
42 ;
43PRINTREC(IEN) ;
44 N ORDER,PROV,ACKDT
45 S ORDER=+$G(^ORA(102.4,IEN,0))
46 S PROV=$P($G(^ORA(102.4,IEN,0)),U,2)
47 S PROV=$P($G(^VA(200,PROV,0)),U)
48 S ACKDT=$$FMTE^XLFDT($P($G(^ORA(102.4,IEN,0)),U,3))
49 I $G(ORDER) W !!,"ORDER: ",ORDER,?35,"PROVIDER: ",PROV
50 I $L($G(ACKDT)) W !,?10,"ACKNOWLEDGEMENT DATE/TIME: ",ACKDT
51 Q
52 ;
53PRINTLST(LIST,NUM) ;
54 N %ZIS
55 S %ZIS="M" D ^%ZIS U IO
56 N I,ORRCQ
57 S ORRCQ=0
58 Q:'$D(LIST)
59 W @IOF
60 D HDR(NUM)
61 S I=0 F S I=$O(LIST(I)) Q:'I!(ORRCQ) D
62 .D PRINTREC(I)
63 .I $Y>(IOSL-3)&(IOST["C-") S ORRCQ='$$PAUSE() D
64 ..Q:ORRCQ
65 ..W @IOF
66 ..D HDR(NUM)
67 W !,"_________________________________________________",!!
68 I ORRCQ W !,"Exiting report before complete..."
69 I 'ORRCQ W !,"End of report."
70 D ^%ZISC
71 Q
72HDR(NUM) ;
73 I NUM=1 D
74 . W !,"Listing of ORDER ACKNOWLEDGEMENTS by order number"
75 . W !,"================================================="
76 I NUM=2 D
77 . W !,"Listing of ORDER ACKNOWLEDGMENTES by Provider"
78 . W !,"============================================="
79 Q 0
80PAUSE() ;
81 N DIR,X,Y,DTOUT,DUOUT,DIRUT
82 S DIR(0)="E"
83 D ^DIR
84 Q $S(Y'=1:0,1:1)
Note: See TracBrowser for help on using the repository browser.