| 1 | QACI1A ; 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 | ;
|
|---|
| 4 | DEFDATE(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 | ;
|
|---|
| 13 | ENRPT2 ; 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 | ;
|
|---|
| 23 | DQRPT ; 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 | ;
|
|---|
| 44 | DQRPT2 ; 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 | ;
|
|---|
| 66 | HDR 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 | ;
|
|---|
