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
 ;