Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDFPE

IBDFPE.m

Go to the documentation of this file.
  1. IBDFPE ;MAF/ALB - ENCOUNTER FORMS QUEUEING PARAMETERS DISPLAY 1 31 94
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
  1. EN ; -- main entry point for IBDF EF QUEUE PARMS
  1. D EN^VALM("IBDF EF QUEUE PARMS")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)="This is the list of Print Manager's Queuing Parameters (PMQP) for your facility"
  1. S VALMHDR(2)="You may enter new ones or edit those already set up."
  1. Q
  1. ;
  1. ;
  1. INIT ; -- init variables and list array
  1. N IBFASTXT
  1. S (IBDCAT,IBDNME,IBDTYPE,VALMCNT,IBDCNT,IBDCNT1,IBFASTXT)=0
  1. K ^TMP("IBDRPT",$J),^TMP("IBDIDX",$J)
  1. F IBDNUM=0:0 S IBDNUM=$O(^IBD(357.09,IBDNUM)) Q:'IBDNUM F IBDNAME=0:0 S IBDNME=$O(^IBD(357.09,IBDNUM,"Q","B",IBDNME)) Q:IBDNME="" F IBDIFN=0:0 S IBDIFN=$O(^IBD(357.09,IBDNUM,"Q","B",IBDNME,IBDIFN)) Q:IBDIFN']"" D SET1
  1. I '$D(^TMP("IBDRPT",$J)) D NUL
  1. Q
  1. ;
  1. ;
  1. SET1 ; -- Set up List
  1. S IBDNODE=$G(^IBD(357.09,1,"Q",IBDIFN,0))
  1. S IBDCNT1=IBDCNT1+1
  1. S X="",X=$$SETSTR^VALM1(IBDCNT1_")",X,1,3)
  1. S X=$$SETSTR^VALM1($P(IBDNODE,"^",1),X,30,40) D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
  1. S IBDCAT($P(IBDNODE,"^",1))=IBDCNT,IBDTYPE(IBDCNT1)=IBDIFN_"^"_IBDNUM
  1. S X="",X=$$SETSTR^VALM1($$LOWER^VALM1(" STARTING DATE/TIME: "),X,1,22)
  1. S IBDVAL=$S($P(IBDNODE,"^",2)]"":$$FDTTM^VALM1($P(IBDNODE,"^",2)),1:"")
  1. S X=$$SETSTR^VALM1(IBDVAL,X,23,17)
  1. S IBDVAL=$S($P(IBDNODE,"^",7)]"":$P(IBDNODE,"^",7),1:"")
  1. S X=$$SETSTR^VALM1($$LOWER^VALM1("DAYS TO PRINT AHEAD: "),X,40,21)
  1. S X=$$SETSTR^VALM1($J(IBDVAL,5),X,65,5) D TMP
  1. S X="",X=$$SETSTR^VALM1($$LOWER^VALM1(" ENDING DATE/TIME: "),X,1,22)
  1. S IBDVAL=$S($P(IBDNODE,"^",3)]"":$$FDTTM^VALM1($P(IBDNODE,"^",3)),1:"")
  1. S X=$$SETSTR^VALM1(IBDVAL,X,23,17)
  1. S IBDVAL=$P(IBDNODE,"^",5)
  1. S X=$$SETSTR^VALM1($$LOWER^VALM1(" ADD ONS ONLY: "),X,40,21)
  1. S X=$$SETSTR^VALM1($J($S(IBDVAL=1:"YES",1:"NO"),5),X,65,5) D TMP
  1. S X="",X=$$SETSTR^VALM1($$LOWER^VALM1(" CLINIC GROUPS: "),X,1,22)
  1. S IBDVAL=$P($G(^IBD(357.99,+$P(IBDNODE,"^",6),0)),"^",1)
  1. S X=$$SETSTR^VALM1(IBDVAL,X,23,17)
  1. S X=$$SETSTR^VALM1($$LOWER^VALM1(" LAST DATE PRINTED: "),X,40,21)
  1. S IBDVAL=$S($P(IBDNODE,"^",12)]"":$$FDTTM^VALM1($P(IBDNODE,"^",12)),1:"")
  1. S X=$$SETSTR^VALM1(IBDVAL,X,62,17) D TMP
  1. S IBDVAL=$P(IBDNODE,"^",4)
  1. S IBDVAL=$$LOWER^VALM1($S(IBDVAL=2:"DIV/TERM DIG",IBDVAL=3:"DIV/CLIN/TERM DIG",1:"DIV/CLIN/PATIENT"))
  1. S X="",X=$$SETSTR^VALM1($$LOWER^VALM1(" SORT BY: "),X,1,22)
  1. S X=$$SETSTR^VALM1(IBDVAL,X,23,18)
  1. S IBDVAL=$S($P(IBDNODE,"^",10)]"":$P(IBDNODE,"^",10),1:"")
  1. S X=$$SETSTR^VALM1($$LOWER^VALM1(" PRINT PRIORITY: "),X,40,21)
  1. S X=$$SETSTR^VALM1($J(IBDVAL,5),X,65,5) D TMP
  1. S IBDVAL=$P(IBDNODE,"^",8)
  1. S IBDVAL=$$LOWER^VALM1($S(IBDVAL="R":"RUN REGARDLESS",IBDVAL="I":"IGNORE HOLIDAYS/WEEKENDS",IBDVAL="H":"IGNORE HOLIDAYS",IBDVAL="W":"IGNORE WEEKENDS",IBDVAL="N":"NOT ACTIVE",1:"RUN TODAY"))
  1. S X="",X=$$SETSTR^VALM1($$LOWER^VALM1("SPECIAL INSTRUCTIONS: "),X,1,22)
  1. S X=$$SETSTR^VALM1(IBDVAL,X,23,30)
  1. S X=$$SETSTR^VALM1($$LOWER^VALM1("DEVICE/TIME QUEUED: "),X,41,21)
  1. S IBDVAL=$$LOWER^VALM1($E($P(IBDNODE,"^",9),1,12))_$S($P(IBDNODE,"^",13)="0000":" @",$P(IBDNODE,"^",13):" @",1:"")_$S($P(IBDNODE,"^",13)="0000":"0000",$P(IBDNODE,"^",13):$P(IBDNODE,"^",13),1:"")
  1. S X=$$SETSTR^VALM1(IBDVAL,X,62,18) D TMP
  1. S X="",X=$$SETSTR^VALM1(X,X,1,80) D TMP
  1. Q
  1. ;
  1. ;
  1. TMP ; -- Set up Array
  1. S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
  1. S ^TMP("IBDRPT",$J,IBDCNT,0)=X,^TMP("IBDRPT",$J,"IDX",VALMCNT,IBDCNT1)=""
  1. S ^TMP("IBDIDX",$J,IBDCNT)=VALMCNT_"^"_IBDIFN
  1. Q
  1. ;
  1. ;
  1. JUMP ; -- Jump to a Specific Parameter Set
  1. D FULL^VALM1
  1. I $D(XQORNOD(0)),$P(XQORNOD(0),"^",4)]"" S X=$P(XQORNOD(0),"^",4) S X=$P(X,"=",2) I X]"" D:X?1.6N JSEL S DA(1)=1,DIC="^IBD(357.09,"_DA(1)_","_"""Q"""_",",DIC(0)="QEZ" D ^DIC G:Y<0 JMP S Y=+Y D JUMP1 Q
  1. JMP S DA(1)=1,DIC="^IBD(357.09,"_DA(1)_","_"""Q"""_",",DIC(0)="AEMN",DIC("A")="Select Parameter Group you wish to move to: " D ^DIC K DIC
  1. I X["^" S VALMBG=1,VALMBCK="R" Q
  1. JUMP1 I Y<0 G JUMP
  1. N IBDXCAT
  1. S IBDXCAT=$P(^IBD(357.09,DA(1),"Q",+Y,0),"^",1)
  1. I '$D(IBDCAT(IBDXCAT)) W !!,"There is no data listed for this Parameter Group" G JMP
  1. S VALMBG=IBDCAT(IBDXCAT) S VALMBCK="R" K DA(1) Q
  1. Q
  1. ;
  1. ;
  1. JSEL ; -- Convert number selected to name
  1. S IBDVALM=X,X=$S($D(IBDTYPE(IBDVALM)):$P(IBDTYPE(IBDVALM),"^",1),1:"") I X]"" S DA(1)=1,X=$P(^IBD(357.09,DA(1),"Q",X,0),"^",1)
  1. Q
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. ;
  1. EXIT ; -- exit code
  1. K IBDCAT,IBDNME,IBDTYPE,VALMCNT,IBDCNT,IBDCNT1,IBDNAME,IBDNUM,IBDNME,IBDIFN,IBDVAL,IBDNODE,IBFASTXT
  1. K ^TMP("IBDRPT",$J),^TMP("IBDIDX",$J)
  1. Q
  1. ;
  1. NUL ; -- NULL MESSAGE
  1. S ^TMP("IBDRPT",$J,1,0)=" ",^TMP("IBDRPT",$J,2,0)="There are no PARAMETER GROUPS listed.",^TMP("IBDIDX",$J,1)=1,^TMP("IBDIDX",$J,2)=2
  1. Q