- 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 Feb 19, 2025@00:19:32 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