source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACI1A.m@ 975

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1QACI1A ; OAKOIFO/TKW - DATA MIGRATION - AUTO-CLOSE ROCS (CONTINUED) ;10/26/06 11:23
2 ;;2.0;Patient Representative;**19**;07/25/1995;Build 55
3 ;
4DEFDATE(DATEIN) ; Return default date for auto-closing ROCs
5 N MM,YY
6 I '$G(DATEIN) S DATEIN=$$DT^XLFDT()
7 S MM=$E(DATEIN,4,5),YY=$E(DATEIN,1,3)
8 S MM=$S(MM>9:"07",MM>6:"04",MM>3:"01",1:"10")
9 I MM=10 S YY=YY-1
10 Q YY_MM_"01"
11 ;
12 ;
13ENRPT2 ; Print report of auto-closed ROCs
14 I $O(^XTMP("QACMIGR","AUTO","C",""))="" W !!,"No ROCs have been Auto-Closed!",!! Q
15 W !!,"Ready to print report of auto-closed ROCs",!
16 N PATSHDR,PATSTYPE
17 S PATSTYPE="AUTO"
18 S PATSHDR="AUTO-CLOSED ROCS",PATSHDR(1)="ROC Number Date Closed NULL Fields changed"
19 N ZTSAVE S ZTSAVE("PATSTYPE")="",ZTSAVE("PATSHDR")=""
20 D EN^XUTMDEVQ("DQRPT2^QACI1A","Report of "_ZTSAVE("PATSHDR"),.ZTSAVE)
21 Q
22 ;
23DQRPT ; Report errors found while processing ROCs
24 N PAGENO,LNCNT,LASTROC,ROCNO,ERRMSG,INFO,HDDATE,X,%,%H,%I
25 S PAGENO=1,LNCNT=0
26 D NOW^%DTC S HDDATE=$$FMTE^XLFDT(%)
27 U IO D HDR
28 S (LASTROC,ROCNO)=""
29 F S ROCNO=$O(^XTMP("QACMIGR",PATSTYPE,"E",ROCNO)) Q:ROCNO="" D
30 . I LASTROC'=ROCNO D
31 .. D:LNCNT>53 HDR
32 .. W !,ROCNO
33 .. S LASTROC=ROCNO,LNCNT=LNCNT+1
34 .. Q
35 . F I=0:0 S I=$O(^XTMP("QACMIGR",PATSTYPE,"E",ROCNO,I)) Q:'I S X=^(I) D
36 .. S ERRMSG=$P(X,"^") S:I=1 INFO=$P(X,"^",2)
37 .. D:LNCNT>54 HDR
38 .. I I=1 W ?15,"Info Taker: ",INFO,! S LNCNT=LNCNT+1
39 .. W ?15,ERRMSG,!
40 .. S LNCNT=LNCNT+1 Q
41 . Q
42 D ^%ZISC Q
43 ;
44DQRPT2 ; Report list of auto-closed ROCs
45 N PAGENO,LNCNT,ROCNO,ERRMSG,HDDATE,%,%H,%I,PATSS,X
46 S PATSS="D" I PATSTYPE="AUTO" S PATSS="C"
47 S PAGENO=1,LNCNT=0
48 D NOW^%DTC S HDDATE=$$FMTE^XLFDT(%)
49 U IO D HDR
50 S ROCNO=""
51 F S ROCNO=$O(^XTMP("QACMIGR",PATSTYPE,PATSS,ROCNO)) Q:ROCNO="" S X=^(ROCNO) D
52 . D:LNCNT>54 HDR
53 . W !,ROCNO
54 . I PATSTYPE="AUTO" D
55 .. W ?15,$P(X,"^")
56 .. I $P(X,"^",2) W " Edited By"
57 .. I $P(X,"^",3) W " Info Taken By"
58 .. I $P(X,"^",4) W " Issue Text"
59 .. I $P(X,"^",5) W " Resolution Text"
60 .. I $P(X,"^",6) W " Division"
61 .. Q
62 . S LNCNT=LNCNT+1
63 . Q
64 D ^%ZISC Q
65 ;
66HDR W #,!,PATSHDR,?43,HDDATE,?68,"Page "_PAGENO,!
67 I $D(PATSHDR(1)) W PATSHDR(1),!
68 N X S X="",$P(X,"-",78)=""
69 W X,!
70 S LNCNT=0,PAGENO=PAGENO+1 Q
71 ;
72 ;
Note: See TracBrowser for help on using the repository browser.