VistA-WorldVistAEHR/r/PATIENT_REPRESENTATIVE-QAC/QACI1A.m

73 lines
2.1 KiB
Mathematica

QACI1A ; OAKOIFO/TKW - DATA MIGRATION - AUTO-CLOSE ROCS (CONTINUED) ;10/26/06 11:23
;;2.0;Patient Representative;**19**;07/25/1995;Build 55
;
DEFDATE(DATEIN) ; Return default date for auto-closing ROCs
N MM,YY
I '$G(DATEIN) S DATEIN=$$DT^XLFDT()
S MM=$E(DATEIN,4,5),YY=$E(DATEIN,1,3)
S MM=$S(MM>9:"07",MM>6:"04",MM>3:"01",1:"10")
I MM=10 S YY=YY-1
Q YY_MM_"01"
;
;
ENRPT2 ; Print report of auto-closed ROCs
I $O(^XTMP("QACMIGR","AUTO","C",""))="" W !!,"No ROCs have been Auto-Closed!",!! Q
W !!,"Ready to print report of auto-closed ROCs",!
N PATSHDR,PATSTYPE
S PATSTYPE="AUTO"
S PATSHDR="AUTO-CLOSED ROCS",PATSHDR(1)="ROC Number Date Closed NULL Fields changed"
N ZTSAVE S ZTSAVE("PATSTYPE")="",ZTSAVE("PATSHDR")=""
D EN^XUTMDEVQ("DQRPT2^QACI1A","Report of "_ZTSAVE("PATSHDR"),.ZTSAVE)
Q
;
DQRPT ; Report errors found while processing ROCs
N PAGENO,LNCNT,LASTROC,ROCNO,ERRMSG,INFO,HDDATE,X,%,%H,%I
S PAGENO=1,LNCNT=0
D NOW^%DTC S HDDATE=$$FMTE^XLFDT(%)
U IO D HDR
S (LASTROC,ROCNO)=""
F S ROCNO=$O(^XTMP("QACMIGR",PATSTYPE,"E",ROCNO)) Q:ROCNO="" D
. I LASTROC'=ROCNO D
.. D:LNCNT>53 HDR
.. W !,ROCNO
.. S LASTROC=ROCNO,LNCNT=LNCNT+1
.. Q
. F I=0:0 S I=$O(^XTMP("QACMIGR",PATSTYPE,"E",ROCNO,I)) Q:'I S X=^(I) D
.. S ERRMSG=$P(X,"^") S:I=1 INFO=$P(X,"^",2)
.. D:LNCNT>54 HDR
.. I I=1 W ?15,"Info Taker: ",INFO,! S LNCNT=LNCNT+1
.. W ?15,ERRMSG,!
.. S LNCNT=LNCNT+1 Q
. Q
D ^%ZISC Q
;
DQRPT2 ; Report list of auto-closed ROCs
N PAGENO,LNCNT,ROCNO,ERRMSG,HDDATE,%,%H,%I,PATSS,X
S PATSS="D" I PATSTYPE="AUTO" S PATSS="C"
S PAGENO=1,LNCNT=0
D NOW^%DTC S HDDATE=$$FMTE^XLFDT(%)
U IO D HDR
S ROCNO=""
F S ROCNO=$O(^XTMP("QACMIGR",PATSTYPE,PATSS,ROCNO)) Q:ROCNO="" S X=^(ROCNO) D
. D:LNCNT>54 HDR
. W !,ROCNO
. I PATSTYPE="AUTO" D
.. W ?15,$P(X,"^")
.. I $P(X,"^",2) W " Edited By"
.. I $P(X,"^",3) W " Info Taken By"
.. I $P(X,"^",4) W " Issue Text"
.. I $P(X,"^",5) W " Resolution Text"
.. I $P(X,"^",6) W " Division"
.. Q
. S LNCNT=LNCNT+1
. Q
D ^%ZISC Q
;
HDR W #,!,PATSHDR,?43,HDDATE,?68,"Page "_PAGENO,!
I $D(PATSHDR(1)) W PATSHDR(1),!
N X S X="",$P(X,"-",78)=""
W X,!
S LNCNT=0,PAGENO=PAGENO+1 Q
;
;