71 lines
4.8 KiB
Mathematica
71 lines
4.8 KiB
Mathematica
|
IBDFFT3 ;ALB/MAF - ROUTINE TO QUEUE FORMS TRACKING REPORT - 13 NOV 96
|
||
|
|
;;3.0;AUTOMATED INFO COLLECTION SYS;**16**;APR 24, 1997
|
||
|
|
S IBDFDAT=$P($$HTE^XLFDT($H),":",1,2)
|
||
|
|
N IBDCNT,IBDCNT1,IBDFTIME,IBFLAG,IBDFPAGE
|
||
|
|
S (IBDCNT,IBDNKA,IBDFPAGE,IBDCNT1,VALMCNT)=0
|
||
|
|
S IBDFL=IBDFL_"^IBDFFT1" D @(IBDFL)
|
||
|
|
N IBDFDV,IBDFCL,IBDNODE,IBDFTMP,IBDFPAT,IBDFPT,IBDFT
|
||
|
|
S (IBDFDV,IBDFCL,IBDFPT)=0
|
||
|
|
I $D(VAUTG) D
|
||
|
|
.N IBDFGR
|
||
|
|
.S IBDFGR=0
|
||
|
|
.F IBDFDIV=0:0 S IBDFDV=$O(^TMP("FTRK",$J,IBDFDV)) Q:IBDFDV']"" D:'$D(IBDFDIV(IBDFDV)) HEADER^IBDFFT4 F IBDFGRO=0:0 S IBDFGR=$O(^TMP("FTRK",$J,IBDFDV,IBDFGR)) Q:IBDFGR']"" D
|
||
|
|
..F IBDFCLI=0:0 S IBDFCL=$O(^TMP("FTRK",$J,IBDFDV,IBDFGR,IBDFCL)) Q:IBDFCL']"" D:'$D(IBDFCLIN(IBDFGR,IBDFCL)) HEADER1^IBDFFT4 D
|
||
|
|
...F IBDFT=0:0 S IBDFT=$O(^TMP("FTRK",$J,IBDFDV,IBDFGR,IBDFCL,IBDFT)) Q:'IBDFT F IBDFPAT=0:0 S IBDFPT=$O(^TMP("FTRK",$J,IBDFDV,IBDFGR,IBDFCL,IBDFT,IBDFPT)) Q:IBDFPT']"" D
|
||
|
|
....F IBDFIFN=0:0 S IBDFIFN=$O(^TMP("FTRK",$J,IBDFDV,IBDFGR,IBDFCL,IBDFT,IBDFPT,IBDFIFN)) Q:'IBDFIFN S IBDX="" F S IBDX=$O(^TMP("FTRK",$J,IBDFDV,IBDFGR,IBDFCL,IBDFT,IBDFPT,IBDFIFN,IBDX)) Q:IBDX="" S IBDFTMP=^(IBDX) D PRINT
|
||
|
|
I '$D(VAUTG) D
|
||
|
|
.F IBDFDIV=0:0 S IBDFDV=$O(^TMP("FTRK",$J,IBDFDV)) Q:IBDFDV']"" D:'$D(IBDFDIV(IBDFDV)) HEADER^IBDFFT4 F IBDFCLI=0:0 S IBDFCL=$O(^TMP("FTRK",$J,IBDFDV,IBDFCL)) Q:IBDFCL']"" D:'$D(IBDFCLIN(IBDFDV,IBDFCL)) HEADER1^IBDFFT4 D
|
||
|
|
..F IBDFT=0:0 S IBDFT=$O(^TMP("FTRK",$J,IBDFDV,IBDFCL,IBDFT)) Q:'IBDFT F IBDFPAT=0:0 S IBDFPT=$O(^TMP("FTRK",$J,IBDFDV,IBDFCL,IBDFT,IBDFPT)) Q:IBDFPT']"" D
|
||
|
|
...F IBDFIFN=0:0 S IBDFIFN=$O(^TMP("FTRK",$J,IBDFDV,IBDFCL,IBDFT,IBDFPT,IBDFIFN)) Q:'IBDFIFN S IBDX="" F S IBDX=$O(^TMP("FTRK",$J,IBDFDV,IBDFCL,IBDFT,IBDFPT,IBDFIFN,IBDX)) Q:IBDX="" S IBDFTMP=^(IBDX) D PRINT
|
||
|
|
I '$D(^TMP("FRM",$J)) D NUL^IBDFFT4 Q
|
||
|
|
;Do statistics page right after printing list D EN^IBDFST1
|
||
|
|
D EN^IBDFST1
|
||
|
|
Q
|
||
|
|
PRINT ; -- Set up Listman array
|
||
|
|
S DFN=$P(IBDFTMP,"^",3)
|
||
|
|
I '$D(^TMP("CNT",$J,$S(IBDFDV]"":IBDFDV,1:"NOT SPECIFIED"),IBDFCL)) D
|
||
|
|
.S ^TMP("CNT",$J,$S(IBDFDV]"":IBDFDV,1:"NOT SPECIFIED"),IBDFCL)="0^0^0^0^0^0"
|
||
|
|
.I $D(VAUTG) I '$D(^TMP("COUNT",$J,$S(IBDFDV]"":IBDFDV,1:"NOT SPECIFIED"),IBDFGR,IBDFCL)) D
|
||
|
|
..S ^TMP("COUNT",$J,$S(IBDFDV]"":IBDFDV,1:"NOT SPECIFIED"),IBDFGR,IBDFCL)=1
|
||
|
|
I $D(VAUTG) K IBDFLAG I $D(^TMP("COUNT",$J,IBDFCL,IBDFT,IBDFIFN)) I IBDFGR=^TMP("COUNT",$J,IBDFCL,IBDFT,IBDFIFN) D COUNT
|
||
|
|
I $D(VAUTG) I '$D(^TMP("COUNT",$J,IBDFCL,IBDFT,IBDFIFN)) D COUNT
|
||
|
|
I '$D(VAUTG) S $P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",1)=$P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",1)+1
|
||
|
|
S IBDCNT1=IBDCNT1+1
|
||
|
|
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
|
||
|
|
W !
|
||
|
|
W $J(IBDCNT1_")",5)
|
||
|
|
W ?7,$E($P($G(IBDFTMP),"^",2),1,8)
|
||
|
|
S IBDFVAL=$P($G(IBDFTMP),"^",4) I IBDFVAL S DNKA=$$DNKA^IBDFFT1(DFN,IBDFVAL),IBDFVAL=$$FMTE^XLFDT(IBDFVAL,2)
|
||
|
|
W ?17,$E(IBDFVAL,1,14)
|
||
|
|
I $D(VAUTC)!($D(VAUTG)) S (IBDFVAL,IBDFN)=$P($G(IBDFTMP),"^",3) I IBDFVAL]"" S IBDFVAL=$P(^DPT(IBDFVAL,0),"^",1)
|
||
|
|
I $D(VAUTN) S (IBDFVAL,IBDFN)=$P($G(IBDFTMP),"^",1) I IBDFVAL]"" S IBDFVAL=$P(^SC(IBDFVAL,0),"^",1)
|
||
|
|
W ?34,$E(IBDFVAL,1,15)
|
||
|
|
S IBDFVAL=$P($G(IBDFTMP),"^",6)
|
||
|
|
I IBDFVAL]"" S IBDFVAL=$E(IBDFVAL,4,5)_"/"_$E(IBDFVAL,6,7)_"/"_$E(IBDFVAL,2,3) I '$D(VAUTG)!($D(VAUTG)&($D(IBDFLAG))) S $P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",2)=+($P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",2))+1
|
||
|
|
W ?50,$E(IBDFVAL,1,8)
|
||
|
|
S VAL=$P($G(IBDFTMP),"^",12)
|
||
|
|
S IBDFVAL=$P($G(IBDFTMP),"^",7)
|
||
|
|
I IBDFVAL]"" S IBDFVAL=$E(IBDFVAL,4,5)_"/"_$E(IBDFVAL,6,7)_"/"_$E(IBDFVAL,2,3) I '$D(VAUTG)!($D(VAUTG)&($D(IBDFLAG))) I VAL=2 S $P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",3)=+($P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",3))+1
|
||
|
|
W ?61,$E(IBDFVAL,1,8)
|
||
|
|
N IBDFXX
|
||
|
|
S IBDFXX=$S(VAL=3:3,VAL=6:5,1:"")
|
||
|
|
I IBDFXX]"" I '$D(VAUTG)!($D(VAUTG)&($D(IBDFLAG))) S $P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",IBDFXX)=$P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",IBDFXX)+1 S $P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",6)=$P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",6)+1
|
||
|
|
S VAL=$S(DNKA:$P(DNKA,"^",2),VAL=1:"PRINTED",VAL=2:"SCANNED",VAL=3:"SCD/PCE",VAL=4:"SCD w/ER",VAL=5:"DENTRY",VAL=6:"DE to PCE",VAL=7:"DE w/ER",VAL=11:"PEND Pgs",VAL=12:"ER/NOTRN",20:"AVAIL DE",1:"NOT PRNT")
|
||
|
|
I DNKA S $P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",7)=+($P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",7))+1
|
||
|
|
W ?72,$E(VAL,1,8)
|
||
|
|
S IBDFVAL=$S(DNKA:"",1:$$SCHSTAT^IBDFFT($P(IBDFTMP,"^",3),$P(IBDFTMP,"^",4)))
|
||
|
|
W ?82,$E(IBDFVAL,1,12)
|
||
|
|
S IBDFVAL=$S($P(IBDFTMP,"^",14):" Yes",1:" No")
|
||
|
|
W ?96,$E(IBDFVAL,1,6)
|
||
|
|
;
|
||
|
|
;
|
||
|
|
TMP ; -- Set up TMP Array
|
||
|
|
S ^TMP("FRM",$J,IBDCNT,0)=$$LOWER^VALM1(X),^TMP("FRM",$J,"IDX",VALMCNT,IBDCNT1)=""
|
||
|
|
S ^TMP("FRMIDX",$J,IBDCNT1)=VALMCNT_"^"_$P(IBDFTMP,"^",2)_"^"_$P(IBDFTMP,"^",3)_"^"_$P(IBDFTMP,"^",4)_"^"_$P(IBDFTMP,"^",6)_"^"_$P(IBDFTMP,"^",7)_"^"_$P(IBDFTMP,"^",12)
|
||
|
|
D NOW^%DTC S IBDFTIME=% S X1=$S($P(IBDFTMP,"^",7):$P(IBDFTMP,"^",7),1:IBDFTIME),X2=$P(IBDFTMP,"^",4) D ^%DTC S $P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",4)=+($P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",4))+X
|
||
|
|
Q
|
||
|
|
COUNT ;
|
||
|
|
S ^TMP("COUNT",$J,IBDFCL,IBDFT,IBDFIFN)=IBDFGR,IBDFLAG=1
|
||
|
|
S $P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",1)=$P(^TMP("CNT",$J,IBDFDV,IBDFCL),"^",1)+1
|
||
|
|
Q
|