111 lines
5.2 KiB
Mathematica
111 lines
5.2 KiB
Mathematica
IBDFSS ;ALB/MAF - STATUS SELECT ROUTINE (FORMS TRACKING) ; 11-JUL-1995
|
|
;;3.0;AUTOMATED INFO COLLECTION SYS;**16**;APR 24, 1997
|
|
;
|
|
;
|
|
START ; -- Ask status to be displayed
|
|
D FULL^VALM1
|
|
K IBSTAT
|
|
S DIR("A")="Select ENCOUNTER FORM STATUS: ",DIR("B")="ALL"
|
|
S DIR(0)="SA^A:ALL;1:PRINTED;2:SCANNED;3:SCANNED TO PCE;4:SCANNED W/PCE ERROR;5:DATA ENTRY;6:DATA ENTRY TO PCE;7:DATA ENTRY W/PCE ERROR;11:PENDING PAGES;12:ERROR DETECTED, NOT TRANSMITTED;20:AVAILABLE FOR DATA ENTRY"
|
|
S DIR("?")="Enter desired status that you would like to have listed on the report"
|
|
D ^DIR
|
|
I $D(DTOUT)!$D(DUOUT) Q
|
|
I Y="A" D K DIR Q
|
|
.F X=0,1,2,3,4,5,6,7,11,12,20 S IBSTAT(X)=""
|
|
.S IBDFALL=1
|
|
D SET
|
|
S $P(DIR(0),"^",1)=$P(DIR(0),"^",1)_"O",$P(DIR(0),"^",2)=$E($P(DIR(0),"^",2),7,999) K DIR("B")
|
|
S DIR("A")="Select another STATUS: "
|
|
ASK D ^DIR I $D(DUOUT)!$D(DTOUT) Q
|
|
I X]"" D SET G ASK
|
|
K DIR Q
|
|
;
|
|
;
|
|
SET S X=$S(Y=1:1,Y=2:2,Y=3:3,Y=4:4,Y=5:5,Y=6:6,Y=7:7,Y=11:11,Y=12:12,Y=20:20,1:0)
|
|
S IBSTAT(X)=""
|
|
Q
|
|
;
|
|
;
|
|
EN ; -- main entry point for IBDF FT STATUS SELECT
|
|
D EN^VALM("IBDF FT STATUS SELECT")
|
|
Q
|
|
;
|
|
;
|
|
SETARR ; -- Set up Listman array
|
|
S IBDCNT1=IBDCNT1+1
|
|
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
|
|
S X=""
|
|
S IBDFVAL=$J(IBDCNT1_")",5)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,1,5)
|
|
S IBDFVAL=$P($G(IBDFTMP),"^",2)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,7,8)
|
|
S IBDFVAL=$P($G(IBDFTMP),"^",4) I IBDFVAL S IBDFVAL=$$FMTE^XLFDT(IBDFVAL,2)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,17,14)
|
|
I $D(VAUTC)!($D(VAUTG)) S IBDFVAL=$P($G(IBDFTMP),"^",3) I IBDFVAL]"" S IBDFVAL=$P(^DPT(IBDFVAL,0),"^",1)
|
|
I $D(VAUTN) S IBDFVAL=$P($G(IBDFTMP),"^",1) I IBDFVAL]"" S IBDFVAL=$P(^SC(IBDFVAL,0),"^",1)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,34,15)
|
|
S IBDFVAL=$P($G(IBDFTMP),"^",6) I IBDFVAL]"" S IBDFVAL=$E(IBDFVAL,4,5)_"/"_$E(IBDFVAL,6,7)_"/"_$E(IBDFVAL,2,3)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,50,10)
|
|
S IBDFVAL=$P($G(IBDFTMP),"^",7) I IBDFVAL]"" S IBDFVAL=$E(IBDFVAL,4,5)_"/"_$E(IBDFVAL,6,7)_"/"_$E(IBDFVAL,2,3)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,62,10)
|
|
S IBDFVAL=$P($G(IBDFTMP),"^",12)
|
|
I IBDFVAL']""&($D(STATUS)) S IBDFVAL=$S(STATUS="":"AVL DE",STATUS["N":"NO SHOW","C^NA^CA^PC^PCA^"[STATUS:"CANCELED",1:"AVL DE")
|
|
S IBDFVAL=$S(IBDFVAL=1:"PRINTD",IBDFVAL=2:"SCANND",IBDFVAL=3:"SC/PCE",IBDFVAL=4:"SC/ER",IBDFVAL=5:"DENTRY",IBDFVAL=6:"DE/PCE",IBDFVAL=7:"DE/ER",IBDFVAL=11:"PENDNG",IBDFVAL=12:"ER/NTR",IBDFVAL=20:"AVL DE",1:IBDFVAL)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,74,6)
|
|
;
|
|
;
|
|
TMP ; -- Set up TMP Array
|
|
S ^TMP("SSEL",$J,IBDCNT,0)=$$LOWER^VALM1(X),^TMP("SSEL",$J,"IDX",VALMCNT,IBDCNT1)=""
|
|
S ^TMP("SELIDX",$J,IBDCNT1)=VALMCNT_"^"_$P(IBDFTMP,"^",2)_"^"_$P(IBDFTMP,"^",3)_"^"_$P(IBDFTMP,"^",4)_"^"_$P(IBDFTMP,"^",6)_"^"_$P(IBDFTMP,"^",7)_"^"_$P(IBDFTMP,"^",12)
|
|
Q
|
|
;
|
|
;
|
|
HDR ; -- header code
|
|
S IBDFX=$P($$FMTE^XLFDT(IBDFBG),"@")
|
|
S IBDFY=$P($$FMTE^XLFDT(IBDFEND),"@")
|
|
S VALMHDR(1)="Encounter forms with selected status for the date range of "
|
|
S VALMHDR(2)=IBDFX_" to "_IBDFY
|
|
Q
|
|
;
|
|
;
|
|
INIT ; -- init variables and list array
|
|
N IBDCNT,IBDCNT1,IBDFDV,IBDFCL,IBDFTMP,IBDFPT,IBDFPAT,IBDFT,STATUS
|
|
S (IBDFDV,IBDFCL,IBDCNT,IBDCNT1,IBDFPT,VALMCNT)=0
|
|
K ^TMP("SSEL",$J),^TMP("SELIDX",$J)
|
|
I $D(VAUTG) D
|
|
.N IBDFGR
|
|
.S IBDFGR=0
|
|
.F IBDFDIV=0:0 S IBDFDV=$O(^TMP("FTRK",$J,IBDFDV)) Q:IBDFDV']"" F IBDFGRO=0:0 S IBDFGR=$O(^TMP("FTRK",$J,IBDFDV,IBDFGR)) Q:IBDFGR']"" F IBDFCLI=0:0 S IBDFCL=$O(^TMP("FTRK",$J,IBDFDV,IBDFGR,IBDFCL)) Q:IBDFCL']"" 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
|
|
....S STATUS=$P($G(^DPT(+$G(IBDFIFN),"S",+$G(IBDFT),0)),"^",2) I '$D(IBDFALL),STATUS]"" I "^N^C^NA^CA^PC^PCA^"[STATUS Q
|
|
....S IBDFSTAT=$P(IBDFTMP,"^",12) I $D(IBSTAT(+IBDFSTAT))!($D(IBSTAT(20))&(IBDFSTAT="")) D:'$D(IBDFDIV1(IBDFDV)) HEADER^IBDFSS1 D:'$D(IBDFGRP1(IBDFDV,IBDFGR)) HEADER2^IBDFSS1 D:'$D(IBCLIN(IBDFGR,IBDFCL)) HEADER1^IBDFSS1 D SETARR
|
|
I '$D(VAUTG) D
|
|
.F IBDFDIV=0:0 S IBDFDV=$O(^TMP("FTRK",$J,IBDFDV)) Q:IBDFDV']"" F IBDFCLI=0:0 S IBDFCL=$O(^TMP("FTRK",$J,IBDFDV,IBDFCL)) Q:IBDFCL']"" 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
|
|
....S STATUS=$P($G(^DPT(+$G(IBDFIFN),"S",+$G(IBDFT),0)),"^",2) I '$D(IBDFALL),STATUS]"" I "^N^C^NA^CA^PC^PCA^"[STATUS Q
|
|
....S IBDFSTAT=$P(IBDFTMP,"^",12) I $D(IBSTAT(+IBDFSTAT))!($D(IBSTAT(20))&(IBDFSTAT="")) D:'$D(IBDFDIV1(IBDFDV)) HEADER^IBDFSS1 D:'$D(IBCLIN(IBDFDV,IBDFCL)) HEADER1^IBDFSS1 D SETARR
|
|
I '$D(^TMP("SSEL",$J)) D NUL
|
|
Q
|
|
;
|
|
;
|
|
NUL ; -- NULL MESSAGE
|
|
S ^TMP("SSEL",$J,1,0)=" ",^TMP("SSEL",$J,2,0)="There are no encounter forms that meet this criteria.",^TMP("SELIDX",$J,1)=1,^TMP("SELIDX",$J,2)=2
|
|
Q
|
|
;
|
|
;
|
|
HELP ; -- help code
|
|
S X="?" D DISP^XQORM1 W !!
|
|
Q
|
|
;
|
|
;
|
|
EXIT ; -- exit code
|
|
K ^TMP("SSEL",$J),^TMP("SELIDX",$J),IBSTAT,IBCLIN,IBDFDIV1,DIR,IBDFSTAT,IBDFX,IBDFY,IBDFALL
|
|
Q
|
|
;
|
|
;
|
|
EXPND ; -- expand code
|
|
Q
|
|
;
|