IBDFPE ;MAF/ALB - ENCOUNTER FORMS QUEUEING PARAMETERS DISPLAY 1 31 94
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
EN ; -- main entry point for IBDF EF QUEUE PARMS
D EN^VALM("IBDF EF QUEUE PARMS")
Q
;
HDR ; -- header code
S VALMHDR(1)="This is the list of Print Manager's Queuing Parameters (PMQP) for your facility"
S VALMHDR(2)="You may enter new ones or edit those already set up."
Q
;
;
INIT ; -- init variables and list array
N IBFASTXT
S (IBDCAT,IBDNME,IBDTYPE,VALMCNT,IBDCNT,IBDCNT1,IBFASTXT)=0
K ^TMP("IBDRPT",$J),^TMP("IBDIDX",$J)
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
I '$D(^TMP("IBDRPT",$J)) D NUL
Q
;
;
SET1 ; -- Set up List
S IBDNODE=$G(^IBD(357.09,1,"Q",IBDIFN,0))
S IBDCNT1=IBDCNT1+1
S X="",X=$$SETSTR^VALM1(IBDCNT1_")",X,1,3)
S X=$$SETSTR^VALM1($P(IBDNODE,"^",1),X,30,40) D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
S IBDCAT($P(IBDNODE,"^",1))=IBDCNT,IBDTYPE(IBDCNT1)=IBDIFN_"^"_IBDNUM
S X="",X=$$SETSTR^VALM1($$LOWER^VALM1(" STARTING DATE/TIME: "),X,1,22)
S IBDVAL=$S($P(IBDNODE,"^",2)]"":$$FDTTM^VALM1($P(IBDNODE,"^",2)),1:"")
S X=$$SETSTR^VALM1(IBDVAL,X,23,17)
S IBDVAL=$S($P(IBDNODE,"^",7)]"":$P(IBDNODE,"^",7),1:"")
S X=$$SETSTR^VALM1($$LOWER^VALM1("DAYS TO PRINT AHEAD: "),X,40,21)
S X=$$SETSTR^VALM1($J(IBDVAL,5),X,65,5) D TMP
S X="",X=$$SETSTR^VALM1($$LOWER^VALM1(" ENDING DATE/TIME: "),X,1,22)
S IBDVAL=$S($P(IBDNODE,"^",3)]"":$$FDTTM^VALM1($P(IBDNODE,"^",3)),1:"")
S X=$$SETSTR^VALM1(IBDVAL,X,23,17)
S IBDVAL=$P(IBDNODE,"^",5)
S X=$$SETSTR^VALM1($$LOWER^VALM1(" ADD ONS ONLY: "),X,40,21)
S X=$$SETSTR^VALM1($J($S(IBDVAL=1:"YES",1:"NO"),5),X,65,5) D TMP
S X="",X=$$SETSTR^VALM1($$LOWER^VALM1(" CLINIC GROUPS: "),X,1,22)
S IBDVAL=$P($G(^IBD(357.99,+$P(IBDNODE,"^",6),0)),"^",1)
S X=$$SETSTR^VALM1(IBDVAL,X,23,17)
S X=$$SETSTR^VALM1($$LOWER^VALM1(" LAST DATE PRINTED: "),X,40,21)
S IBDVAL=$S($P(IBDNODE,"^",12)]"":$$FDTTM^VALM1($P(IBDNODE,"^",12)),1:"")
S X=$$SETSTR^VALM1(IBDVAL,X,62,17) D TMP
S IBDVAL=$P(IBDNODE,"^",4)
S IBDVAL=$$LOWER^VALM1($S(IBDVAL=2:"DIV/TERM DIG",IBDVAL=3:"DIV/CLIN/TERM DIG",1:"DIV/CLIN/PATIENT"))
S X="",X=$$SETSTR^VALM1($$LOWER^VALM1(" SORT BY: "),X,1,22)
S X=$$SETSTR^VALM1(IBDVAL,X,23,18)
S IBDVAL=$S($P(IBDNODE,"^",10)]"":$P(IBDNODE,"^",10),1:"")
S X=$$SETSTR^VALM1($$LOWER^VALM1(" PRINT PRIORITY: "),X,40,21)
S X=$$SETSTR^VALM1($J(IBDVAL,5),X,65,5) D TMP
S IBDVAL=$P(IBDNODE,"^",8)
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"))
S X="",X=$$SETSTR^VALM1($$LOWER^VALM1("SPECIAL INSTRUCTIONS: "),X,1,22)
S X=$$SETSTR^VALM1(IBDVAL,X,23,30)
S X=$$SETSTR^VALM1($$LOWER^VALM1("DEVICE/TIME QUEUED: "),X,41,21)
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:"")
S X=$$SETSTR^VALM1(IBDVAL,X,62,18) D TMP
S X="",X=$$SETSTR^VALM1(X,X,1,80) D TMP
Q
;
;
TMP ; -- Set up Array
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
S ^TMP("IBDRPT",$J,IBDCNT,0)=X,^TMP("IBDRPT",$J,"IDX",VALMCNT,IBDCNT1)=""
S ^TMP("IBDIDX",$J,IBDCNT)=VALMCNT_"^"_IBDIFN
Q
;
;
JUMP ; -- Jump to a Specific Parameter Set
D FULL^VALM1
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
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
I X["^" S VALMBG=1,VALMBCK="R" Q
JUMP1 I Y<0 G JUMP
N IBDXCAT
S IBDXCAT=$P(^IBD(357.09,DA(1),"Q",+Y,0),"^",1)
I '$D(IBDCAT(IBDXCAT)) W !!,"There is no data listed for this Parameter Group" G JMP
S VALMBG=IBDCAT(IBDXCAT) S VALMBCK="R" K DA(1) Q
Q
;
;
JSEL ; -- Convert number selected to name
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)
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
;
EXIT ; -- exit code
K IBDCAT,IBDNME,IBDTYPE,VALMCNT,IBDCNT,IBDCNT1,IBDNAME,IBDNUM,IBDNME,IBDIFN,IBDVAL,IBDNODE,IBFASTXT
K ^TMP("IBDRPT",$J),^TMP("IBDIDX",$J)
Q
;
NUL ; -- NULL MESSAGE
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFPE 4767 printed Dec 13, 2024@02:53:07 Page 2
IBDFPE ;MAF/ALB - ENCOUNTER FORMS QUEUEING PARAMETERS DISPLAY 1 31 94
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
EN ; -- main entry point for IBDF EF QUEUE PARMS
+1 DO EN^VALM("IBDF EF QUEUE PARMS")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)="This is the list of Print Manager's Queuing Parameters (PMQP) for your facility"
+2 SET VALMHDR(2)="You may enter new ones or edit those already set up."
+3 QUIT
+4 ;
+5 ;
INIT ; -- init variables and list array
+1 NEW IBFASTXT
+2 SET (IBDCAT,IBDNME,IBDTYPE,VALMCNT,IBDCNT,IBDCNT1,IBFASTXT)=0
+3 KILL ^TMP("IBDRPT",$JOB),^TMP("IBDIDX",$JOB)
+4 FOR IBDNUM=0:0
SET IBDNUM=$ORDER(^IBD(357.09,IBDNUM))
if 'IBDNUM
QUIT
FOR IBDNAME=0:0
SET IBDNME=$ORDER(^IBD(357.09,IBDNUM,"Q","B",IBDNME))
if IBDNME=""
QUIT
FOR IBDIFN=0:0
SET IBDIFN=$ORDER(^IBD(357.09,IBDNUM,"Q","B",IBDNME,IBDIFN))
if IBDIFN']""
QUIT
DO SET1
+5 IF '$DATA(^TMP("IBDRPT",$JOB))
DO NUL
+6 QUIT
+7 ;
+8 ;
SET1 ; -- Set up List
+1 SET IBDNODE=$GET(^IBD(357.09,1,"Q",IBDIFN,0))
+2 SET IBDCNT1=IBDCNT1+1
+3 SET X=""
SET X=$$SETSTR^VALM1(IBDCNT1_")",X,1,3)
+4 SET X=$$SETSTR^VALM1($PIECE(IBDNODE,"^",1),X,30,40)
DO TMP
DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
+5 SET IBDCAT($PIECE(IBDNODE,"^",1))=IBDCNT
SET IBDTYPE(IBDCNT1)=IBDIFN_"^"_IBDNUM
+6 SET X=""
SET X=$$SETSTR^VALM1($$LOWER^VALM1(" STARTING DATE/TIME: "),X,1,22)
+7 SET IBDVAL=$SELECT($PIECE(IBDNODE,"^",2)]"":$$FDTTM^VALM1($PIECE(IBDNODE,"^",2)),1:"")
+8 SET X=$$SETSTR^VALM1(IBDVAL,X,23,17)
+9 SET IBDVAL=$SELECT($PIECE(IBDNODE,"^",7)]"":$PIECE(IBDNODE,"^",7),1:"")
+10 SET X=$$SETSTR^VALM1($$LOWER^VALM1("DAYS TO PRINT AHEAD: "),X,40,21)
+11 SET X=$$SETSTR^VALM1($JUSTIFY(IBDVAL,5),X,65,5)
DO TMP
+12 SET X=""
SET X=$$SETSTR^VALM1($$LOWER^VALM1(" ENDING DATE/TIME: "),X,1,22)
+13 SET IBDVAL=$SELECT($PIECE(IBDNODE,"^",3)]"":$$FDTTM^VALM1($PIECE(IBDNODE,"^",3)),1:"")
+14 SET X=$$SETSTR^VALM1(IBDVAL,X,23,17)
+15 SET IBDVAL=$PIECE(IBDNODE,"^",5)
+16 SET X=$$SETSTR^VALM1($$LOWER^VALM1(" ADD ONS ONLY: "),X,40,21)
+17 SET X=$$SETSTR^VALM1($JUSTIFY($SELECT(IBDVAL=1:"YES",1:"NO"),5),X,65,5)
DO TMP
+18 SET X=""
SET X=$$SETSTR^VALM1($$LOWER^VALM1(" CLINIC GROUPS: "),X,1,22)
+19 SET IBDVAL=$PIECE($GET(^IBD(357.99,+$PIECE(IBDNODE,"^",6),0)),"^",1)
+20 SET X=$$SETSTR^VALM1(IBDVAL,X,23,17)
+21 SET X=$$SETSTR^VALM1($$LOWER^VALM1(" LAST DATE PRINTED: "),X,40,21)
+22 SET IBDVAL=$SELECT($PIECE(IBDNODE,"^",12)]"":$$FDTTM^VALM1($PIECE(IBDNODE,"^",12)),1:"")
+23 SET X=$$SETSTR^VALM1(IBDVAL,X,62,17)
DO TMP
+24 SET IBDVAL=$PIECE(IBDNODE,"^",4)
+25 SET IBDVAL=$$LOWER^VALM1($SELECT(IBDVAL=2:"DIV/TERM DIG",IBDVAL=3:"DIV/CLIN/TERM DIG",1:"DIV/CLIN/PATIENT"))
+26 SET X=""
SET X=$$SETSTR^VALM1($$LOWER^VALM1(" SORT BY: "),X,1,22)
+27 SET X=$$SETSTR^VALM1(IBDVAL,X,23,18)
+28 SET IBDVAL=$SELECT($PIECE(IBDNODE,"^",10)]"":$PIECE(IBDNODE,"^",10),1:"")
+29 SET X=$$SETSTR^VALM1($$LOWER^VALM1(" PRINT PRIORITY: "),X,40,21)
+30 SET X=$$SETSTR^VALM1($JUSTIFY(IBDVAL,5),X,65,5)
DO TMP
+31 SET IBDVAL=$PIECE(IBDNODE,"^",8)
+32 SET IBDVAL=$$LOWER^VALM1($SELECT(IBDVAL="R":"RUN REGARDLESS",IBDVAL="I":"IGNORE HOLIDAYS/WEEKENDS",IBDVAL="H":"IGNORE HOLIDAYS",IBDVAL="W":"IGNORE WEEKENDS",IBDVAL="N":"NOT ACTIVE",1:"RUN TODAY"))
+33 SET X=""
SET X=$$SETSTR^VALM1($$LOWER^VALM1("SPECIAL INSTRUCTIONS: "),X,1,22)
+34 SET X=$$SETSTR^VALM1(IBDVAL,X,23,30)
+35 SET X=$$SETSTR^VALM1($$LOWER^VALM1("DEVICE/TIME QUEUED: "),X,41,21)
+36 SET IBDVAL=$$LOWER^VALM1($EXTRACT($PIECE(IBDNODE,"^",9),1,12))_$SELECT($PIECE(IBDNODE,"^",13)="0000":" @",$PIECE(IBDNODE,"^",13):" @",1:"")_$SELECT($PIECE(IBDNODE,"^",13)="0000":"0000",$PIECE(IBDNODE,"^",13):$PIECE(IBDNODE,"^",13),1:"")
+37 SET X=$$SETSTR^VALM1(IBDVAL,X,62,18)
DO TMP
+38 SET X=""
SET X=$$SETSTR^VALM1(X,X,1,80)
DO TMP
+39 QUIT
+40 ;
+41 ;
TMP ; -- Set up Array
+1 SET IBDCNT=IBDCNT+1
SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBDRPT",$JOB,IBDCNT,0)=X
SET ^TMP("IBDRPT",$JOB,"IDX",VALMCNT,IBDCNT1)=""
+3 SET ^TMP("IBDIDX",$JOB,IBDCNT)=VALMCNT_"^"_IBDIFN
+4 QUIT
+5 ;
+6 ;
JUMP ; -- Jump to a Specific Parameter Set
+1 DO FULL^VALM1
+2 IF $DATA(XQORNOD(0))
IF $PIECE(XQORNOD(0),"^",4)]""
SET X=$PIECE(XQORNOD(0),"^",4)
SET X=$PIECE(X,"=",2)
IF X]""
if X?1.6N
DO JSEL
SET DA(1)=1
SET DIC="^IBD(357.09,"_DA(1)_","_"""Q"""_","
SET DIC(0)="QEZ"
DO ^DIC
if Y<0
GOTO JMP
SET Y=+Y
DO JUMP1
QUIT
JMP SET DA(1)=1
SET DIC="^IBD(357.09,"_DA(1)_","_"""Q"""_","
SET DIC(0)="AEMN"
SET DIC("A")="Select Parameter Group you wish to move to: "
DO ^DIC
KILL DIC
+1 IF X["^"
SET VALMBG=1
SET VALMBCK="R"
QUIT
JUMP1 IF Y<0
GOTO JUMP
+1 NEW IBDXCAT
+2 SET IBDXCAT=$PIECE(^IBD(357.09,DA(1),"Q",+Y,0),"^",1)
+3 IF '$DATA(IBDCAT(IBDXCAT))
WRITE !!,"There is no data listed for this Parameter Group"
GOTO JMP
+4 SET VALMBG=IBDCAT(IBDXCAT)
SET VALMBCK="R"
KILL DA(1)
QUIT
+5 QUIT
+6 ;
+7 ;
JSEL ; -- Convert number selected to name
+1 SET IBDVALM=X
SET X=$SELECT($DATA(IBDTYPE(IBDVALM)):$PIECE(IBDTYPE(IBDVALM),"^",1),1:"")
IF X]""
SET DA(1)=1
SET X=$PIECE(^IBD(357.09,DA(1),"Q",X,0),"^",1)
+2 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
+4 ;
EXIT ; -- exit code
+1 KILL IBDCAT,IBDNME,IBDTYPE,VALMCNT,IBDCNT,IBDCNT1,IBDNAME,IBDNUM,IBDNME,IBDIFN,IBDVAL,IBDNODE,IBFASTXT
+2 KILL ^TMP("IBDRPT",$JOB),^TMP("IBDIDX",$JOB)
+3 QUIT
+4 ;
NUL ; -- NULL MESSAGE
+1 SET ^TMP("IBDRPT",$JOB,1,0)=" "
SET ^TMP("IBDRPT",$JOB,2,0)="There are no PARAMETER GROUPS listed."
SET ^TMP("IBDIDX",$JOB,1)=1
SET ^TMP("IBDIDX",$JOB,2)=2
+2 QUIT
