source: FOIAVistA/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACI5.m@ 707

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1QACI5 ; OAKOIFO/TKW - DATA MIGRATION - OPTIONS OUT-OF-ORDER/IN-ORDER ;7/27/05 16:22
2 ;;2.0;Patient Representative;**19**;07/25/1995;Build 55
3EN ; Put Patient Rep (QAC) options out-of-order or back in order again
4 N QACIEN,QACIO,QACX,DIR,X,Y
5 S QACIEN=$$FIND1^DIC(19,,"X","QAC NEW")
6 I 'QACIEN W "QAC NEW option not found!" Q
7 S QACX=$$GET1^DIQ(19,QACIEN_",",2,"I")
8 ; Set QACIO to 0 if menus are out of order, 1 if they're active
9 S QACIO=$S(QACX]"":0,1:1)
10 K DIR,Y
11 W !!," The Patient Rep Options are currently "_$S(QACIO=0:"OUT OF ORDER.",1:"ACTIVE."),!
12 S DIR("A")=" Put Patient Rep Options OUT OF ORDER"
13 I QACIO=0 S DIR("A")=" Reactivate Patient Rep Options"
14 S DIR(0)="YO",DIR("B")="YES"
15 D ^DIR
16 Q:Y'=1
17 D E0
18 Q
19E0 ; Activate/Inactivate Patient Rep menu options.
20 N QACOPT,QACTXT
21 F QACOPT="QAC NEW","QAC EDIT","QAC STATUS","QAC SETUP MENU","QAC ALERT","QAC ROLLUP (MANUAL)" D
22 . I QACIO=1 S QACTXT="Use data migration UTIL option to reactivate."
23 . E S QACTXT=""
24 . D OUT^XPDMENU(QACOPT,QACTXT) Q
25 W !!," * Patient Rep Options have been "_$S(QACIO=0:"Reactivated.",1:"put OUT OF ORDER."),!
26 Q
27 ;
28EN1() ; Entry point from ^QACI2 (set options out of order, kill rollup task
29 ; when data is moved to staging area.)
30 N QACIO S QACIO=1
31 ; Kill the TaskMan task that rolls Patient Rep data up to Austin for VSSC Reports
32 W !!," Stopping (killing) task that rolls up data to Austin..."
33 I '$$KILLRLUP Q 0
34 ; Call routine to put Patient Rep options OUT OF ORDER.
35 D E0
36 Q 1
37 ;
38ENRTASK ; Reschedule task that rolls data up to Austin
39 N DIR,Y W !
40 S DIR("A")=" Reschedule task to roll up data to Austin"
41 S DIR(0)="YO",DIR("B")="YES"
42 S DIR("?",1)="When you migrated data to the staging area, the task that rolls up data"
43 S DIR("?",2)="from the Patient Rep application to Austin was automatically stopped (killed)."
44 S DIR("?",3)=""
45 S DIR("?")="Answer YES if you want to restart the scheduled rollup task."
46 D ^DIR
47 I Y'=1 W !," * no action taken" Q
48 W !,"...processing task--please wait..."
49 D ^QACMAIL0
50 W !," * Task has been rescheduled.",!," Data will be rolled up from Patient Rep to Austin."
51 Q
52 ;
53ENKTASK ; Kill task that rolls data up to Austin
54 N DIR,Y W !
55 S DIR("A")=" Stop (kill) task that rolls up data to Austin"
56 S DIR(0)="YO",DIR("B")="YES"
57 S DIR("?",1)="After data has been migrated into PATS, you will no longer want to run the"
58 S DIR("?",2)="scheduled task that rolls up data from the Patient Rep application to Austin."
59 S DIR("?",3)=""
60 S DIR("?")="Answer YES if you want to stop (kill) the scheduled rollup task."
61 D ^DIR
62 I Y'=1 W !," * no action taken" Q
63 I $$KILLRLUP Q
64 Q
65 ;
66KILLRLUP() ; Kill Taskman Task that rolls Patient Rep data up to Austin for VSSC reports
67 ; Get task number from QAC SITE PARAMETER FILE
68 N QACZTSK,QACHK,ZTSK
69 S ZTSK=""
70 D CHKTSK^QACMAIL0
71 ; If no task number in SITE PARAMETER FILE, job is not scheduled, we can continue.
72 I $G(ZTSK)'>0 W !," * No task is currently scheduled--rollup to Austin is stopped." Q 1
73 I $G(ZTSK(1))=2 W !!," * Task that rolls data up to Austin is currently running.",!," Please try later." Q 0
74 ; If task is not currently scheduled, we can continue.
75 I $G(QACHK)'=1 W !," * No task is currently scheduled--rollup to Austin is stopped." Q 1
76 ; Otherwise, kill the task
77 D KILL^%ZTLOAD
78 I $G(ZTSK(0))'=1 W !!," * Error attempting to kill task "_ZTSK_"!",!," Please contact IRM staff for assistance." Q 0
79 W !," * Task has been stopped (killed).",!," Data will not be rolled up from Patient Rep to Austin."
80 Q 1
81 ;
82EN3 ; Print list of pending ARNs
83 I $E($O(^XTV(8992,"AXQAN","QAC-")),1,4)'="QAC-" W !!,"There are no Pending Notifications!",!! Q
84 N PATSHDR
85 S PATSHDR="Pending Notifications"
86 S PATSHDR(1)="ROC No. From To"
87 N ZTSAVE S ZTSAVE("PATSHDR")=""
88 D EN^XUTMDEVQ("DQRPT3^QACI5","Report of Pending Notifications",.ZTSAVE)
89 Q
90 ;
91EN4 ; Counts of migrated/unmigrated/total/errors
92 N PATSHDR
93 S PATSHDR="PATS Migration Counts"
94 N ZTSAVE S ZTSAVE("PATSHDR")=""
95 D EN^XUTMDEVQ("DQRPT4^QACI5",PATSHDR,.ZTSAVE)
96 Q
97 ;
98DQRPT3 ; Report pending ARNs
99 N PAGENO,LNCNT,NKEY,NIEN,NDATE,NOTIF0,ERRMSG,HDDATE,QACFROM,QACTO,ROCNO,DATESENT,X,%,%H,%I
100 S PAGENO=1,LNCNT=0
101 D NOW^%DTC S HDDATE=$$FMTE^XLFDT(%)
102 U IO D HDR^QACI1A
103 W ! S LNCNT=1
104 S NKEY="QAC-"
105 F S NKEY=$O(^XTV(8992,"AXQAN",NKEY)) Q:$E(NKEY,1,4)'="QAC-" D
106 . F NIEN=0:0 S NIEN=$O(^XTV(8992,"AXQAN",NKEY,NIEN)) Q:'NIEN F NDATE=0:0 S NDATE=$O(^XTV(8992,"AXQAN",NKEY,NIEN,NDATE)) Q:'NDATE D
107 .. S NOTIF0=$G(^XTV(8992,NIEN,"XQA",NDATE,0))
108 .. S QACTO=$P($G(^VA(200,NIEN,0)),"^")
109 .. S QACFROM=$P($G(^VA(200,$P(NOTIF0,";",2),0)),"^")
110 .. S DATESENT=$$FMTE^XLFDT(NDATE)
111 .. S ROCNO=$P(NOTIF0,"-",2)
112 .. D:LNCNT>55 HDR^QACI1A
113 .. W ROCNO,?13,QACFROM,?45,QACTO,!
114 .. W ?2,"Sent: "_DATESENT,!
115 .. W ?2,"Msg: ",$P(NOTIF0,"^",3),!!
116 .. S LNCNT=LNCNT+4
117 .. Q
118 . Q
119 D ^%ZISC Q
120 ;
121DQRPT4 ; Print various counts for migration
122 N PAGENO,CNT,HDDATE,TYPE,DSPTYPE,DASH,X,%,%H,%I
123 S PAGENO=1
124 S DASH=" ",$P(DASH,"-",24)=""
125 D NOW^%DTC S HDDATE=$$FMTE^XLFDT(%)
126 S DSPTYPE("ROC")="ROCs",DSPTYPE("HL")="Hospital Locations"
127 S DSPTYPE("USER")="PATS Users",DSPTYPE("PT")="Patients"
128 S DSPTYPE("CC")="Congressional Contacts"
129 S DSPTYPE("EMPINV")="Employees Involved"
130 S DSPTYPE("FSOS")="Service/Disciplines"
131 U IO D HDR^QACI1A
132 W ! S LNCNT=1
133 S CNT=0 F TYPE="ROC","HL","USER","PT","CC","EMPINV","FSOS" D
134 . S CNT=CNT+$G(^XTMP("QACMIGR",TYPE,"U")) Q
135 I CNT=0 W "** No data in staging area. **",!!
136 E W "** Data moved to the staging area, ready to migrate to PATS **",!!
137 S CNT=0 F I=0:0 S I=$O(^QA(745.1,I)) Q:'I S CNT=CNT+1
138 W "Total Number of ROCs:",$E(DASH,1,20),?42,CNT,!
139 F TYPE="ROC","HL","USER","PT","CC","EMPINV","FSOS" D
140 . W DSPTYPE(TYPE)_" ready to migrate:",$E(DASH,1,23-$L(DSPTYPE(TYPE))),?42,+$G(^XTMP("QACMIGR",TYPE,"U")),!
141 . W ?8,"migrated:"_DASH,?42,+$G(^XTMP("QACMIGR",TYPE,"D")),!
142 . W ?8,"with errors:"_$E(DASH,1,21),?42,+$G(^XTMP("QACMIGR",TYPE,"E")),!!
143 . Q
144 D ^%ZISC Q
145 ;
146ENRSTAT ; Return status for a selected ROC
147 N DIC,X,Y,OLDROC,NEWROC
148 S DIC="^QA(745.1,",DIC(0)="AEMQZ",DIC("A")="Select CONTACT NUMBER: "
149 D ^DIC Q:'Y!(Y=-1)
150 S OLDROC=$P(Y(0),"^")
151 S NEWROC=$$CONVROC^QACI2C(OLDROC)
152 W !!,"**** ROC Status: "
153 I $D(^XTMP("QACMIGR","ROC","D",NEWROC)) W "This ROC has been successfully migrated into PATS.",! Q
154 I $D(^XTMP("QACMIGR","ROC","E",OLDROC_" ")) W "This ROC has errors.",! Q
155 I $D(^XTMP("QACMIGR","ROC","U",NEWROC_" ")) W "This ROC is in the staging area, ready to migrate.",! Q
156 W "No action has been taken for this ROC.",!
157 Q
158 ;
159 ;
Note: See TracBrowser for help on using the repository browser.