IBDFPE1 ;MAF/ALB - ENCOUNTER FORMS QUEUEING PARAMETERS DISPLAY CONT.; 1 31 94
;;3.0;AUTOMATED INFO COLLECTION SYS;**15**;APR 24, 1997
EDT ; -- Edit Parameter Groups
N IBDVALM,IBDAT,VALMY
S VALMBCK=""
D EN^VALM2($G(XQORNOD(0))) G REP:'$O(VALMY(0)) S IBDVALM=0
D FULL^VALM1 S VALMBCK="R"
F IBDVALM=0:0 S IBDVALM=$O(VALMY(IBDVALM)) Q:'IBDVALM S DA=$S($D(IBDTYPE(IBDVALM)):$P(IBDTYPE(IBDVALM),"^",1),1:"") I DA]"" D
.S DA(1)=1,DIE="^IBD(357.09,"_DA(1)_","_"""Q"""_",",DA=DA,DR=".01;.04:.1;.13" D ^DIE K DA,DIE,DIC,DR
D REP Q
;
;
ADD ; -- Add New Print Parameters
D FULL^VALM1
N DLAYGO
I '$O(^IBD(357.09,0))!($O(^IBD(357.09,0))&'$D(^IBD(357.09,+$O(^IBD(357.09,0)),"Q",0))) W ! S DIC="^IBD(357.09,",DIC(0)="AELQMN",DIC("DR")=".01",DLAYGO=357.09 D ^DIC K DIC G:Y<1 REP S DA=+Y D
.;S DIE="^IBD(357.09,",DA=DA,DR="11",DR(2,357.091)=".04:.1" D ^DIE K DA,DIE,DR
W ! S DA(1)=1,DIC("A")="Select Print Mgrs. Queuing Params. Name: ",DIC="^IBD(357.09,"_DA(1)_","_"""Q"""_",",DIC(0)="AELQMN",DIC("DR")=".01",DLAYGO=357.09 D ^DIC K DIC G:Y<1 REP S DA=+Y D
.S DA(1)=1,DIE="^IBD(357.09,"_DA(1)_","_"""Q"""_",",DA=DA
.S DR=".04//"_1_";.05//"_"NO"_";.06"_";.07//"_5_";.08//"_"R"_";.09"_";.1//"_10_";.13//"_0000
.D ^DIE K DA,DIE,DIC,DR
.Q
REP D INIT^IBDFPE S VALMBCK="R" Q
;
STAT ; -- Find out the status of the queued job and kill a tasked job
N IBDVALM,IBDAT,VALMY,IBDFNODE,IBDFSTAT,IBQUIT
S VALMBCK=""
D EN^VALM2($G(XQORNOD(0))) G REP:'$O(VALMY(0)) S IBDVALM=0
D FULL^VALM1 S VALMBCK="R"
F IBDVALM=0:0 S IBDVALM=$O(VALMY(IBDVALM)) Q:'IBDVALM S DA=$S($D(IBDTYPE(IBDVALM)):$P(IBDTYPE(IBDVALM),"^",1),1:"") I DA]"" D K IBQUIT
.S DA(1)=1,IBDFNODE=^IBD(357.09,DA(1),"Q",DA,0) D ASK Q:$D(IBQUIT) D:$D(IBDFSTOP) KILL^%ZTLOAD D:'$D(IBDFSTOP)&(IBDFSTAT]"") STAT^%ZTLOAD D
..D FULL^VALM1
..I IBDFSTAT']"" W !!,"Status of Queued Job <<< "_$P(IBDFNODE,"^",1)_" >>>",!!,"JOB NOT TASKED!" W:$D(IBDFSTOP) " NO NEED TO INTERRUPT JOB!" Q
..W !!,"Status of Queued Job <<< "_$P(IBDFNODE,"^",1)_" >>>",!!
..I $D(ZTSK(0)) W !," TASK: ",$S($D(ZTSK):ZTSK,1:"")_" - ",$S(ZTSK(0)=1:"Defined",1:"Undefined")
..I $D(ZTSK(1)) W !,"STATUS CODE: ",ZTSK(1)
..I $D(ZTSK(2)) W !," STATUS: ",ZTSK(2)
..I $D(IBDFSTOP) W:ZTSK(0)=1 !,"SUCCESSFUL DELETION OF TASK" W !!,"***JOB STOPPED UPON REQUEST***" S:ZTSK=$P(IBDFNODE,"^",11) $P(^IBD(357.09,DA(1),"Q",DA,0),"^",11)="" S:ZTSK=$P(IBDFNODE,"^",14) $P(^IBD(357.09,DA(1),"Q",DA,0),"^",14)=""
..Q
;I IBDFSTAT']"" W !!,"Status of Queued Job <<< "_$P(IBDFNODE,"^",1)_" >>>",!!,"JOB NOT TASKED!" I $D(IBDFSTOP) W " NO NEED TO INTERRUPT JOB!"
K DA,DA(1)
D PAUSE^VALM1,REP Q
Q
;
DEL ; -- Delete Clinic Group
N IBDVALM,VALMY,DIR,DIRUT,DUOUT
S VALMBCK=""
D EN^VALM2($G(XQORNOD(0))) G REP:'$O(VALMY(0)) S IBDVALM=0
D FULL^VALM1 S VALMBCK="R"
;
F IBDVALM=0:0 S IBDVALM=$O(VALMY(IBDVALM)) Q:'IBDVALM S DA=$S($D(IBDTYPE(IBDVALM)):$P(IBDTYPE(IBDVALM),"^",1),1:"") I DA]"" D
.S DA(1)=1,DIK="^IBD(357.09,"_DA(1)_","_"""Q"""_","
.W !!,"Paramater Group: "_$P($G(^IBD(357.09,1,"Q",DA,0)),"^",1)
.W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure you want to delete "_$P($G(^IBD(357.09,1,"Q",DA,0)),"^",1)
.D ^DIR K DIR I Y'=1 W !,"Entry ",$P($G(^IBD(357.09,1,"Q",DA,0)),"^",1)," not Deleted!" Q
.D DP1
;
DELQ D REP
S VALMBCK="R" Q
;
DP1 ; -- actual deletion
S DIK="^IBD(357.09,"_DA(1)_","_"""Q"""_"," D ^DIK
W !,"Entry ",IBDVALM," Deleted"
Q
ASK I $P(IBDFNODE,"^",11)']""!($P(IBDFNODE,"^",14)']"")!($P(IBDFNODE,"^",11)=$P(IBDFNODE,"^",14)) D Q
.S (IBDFSTAT,ZTSK)=$P(IBDFNODE,"^",11)
.Q
S DIR(0)="S^1:CURRENT;2:PREVIOUS"
S DIR("A")="Select action for print group "_$P(IBDFNODE,"^",1)
S DIR("B")="CURRENT"
S DIR("?")=" "
S DIR("?",1)="Choose 1 or 'C' CURRENT TASK"
S DIR("?",2)=" or"
S DIR("?",3)=" 2 or 'P' for PREVIOUS TASK"
S DIR("?",4)=" "
S DIR("?",5)=" Current task # ="_$P(IBDFNODE,"^",11)
S DIR("?",6)=" "
S DIR("?",7)=" Previous task # = "_$P(IBDFNODE,"^",14)
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1
S (IBDFSTAT,ZTSK)=$S(Y=2:$P(IBDFNODE,"^",14),1:$P(IBDFNODE,"^",11))
K DIR Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFPE1 4176 printed Apr 09, 2024@20:52:29 Page 2
IBDFPE1 ;MAF/ALB - ENCOUNTER FORMS QUEUEING PARAMETERS DISPLAY CONT.; 1 31 94
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**15**;APR 24, 1997
EDT ; -- Edit Parameter Groups
+1 NEW IBDVALM,IBDAT,VALMY
+2 SET VALMBCK=""
+3 DO EN^VALM2($GET(XQORNOD(0)))
if '$ORDER(VALMY(0))
GOTO REP
SET IBDVALM=0
+4 DO FULL^VALM1
SET VALMBCK="R"
+5 FOR IBDVALM=0:0
SET IBDVALM=$ORDER(VALMY(IBDVALM))
if 'IBDVALM
QUIT
SET DA=$SELECT($DATA(IBDTYPE(IBDVALM)):$PIECE(IBDTYPE(IBDVALM),"^",1),1:"")
IF DA]""
Begin DoDot:1
+6 SET DA(1)=1
SET DIE="^IBD(357.09,"_DA(1)_","_"""Q"""_","
SET DA=DA
SET DR=".01;.04:.1;.13"
DO ^DIE
KILL DA,DIE,DIC,DR
End DoDot:1
+7 DO REP
QUIT
+8 ;
+9 ;
ADD ; -- Add New Print Parameters
+1 DO FULL^VALM1
+2 NEW DLAYGO
+3 IF '$ORDER(^IBD(357.09,0))!($ORDER(^IBD(357.09,0))&'$DATA(^IBD(357.09,+$ORDER(^IBD(357.09,0)),"Q",0)))
WRITE !
SET DIC="^IBD(357.09,"
SET DIC(0)="AELQMN"
SET DIC("DR")=".01"
SET DLAYGO=357.09
DO ^DIC
KILL DIC
if Y<1
GOTO REP
SET DA=+Y
Begin DoDot:1
+4 ;S DIE="^IBD(357.09,",DA=DA,DR="11",DR(2,357.091)=".04:.1" D ^DIE K DA,DIE,DR
End DoDot:1
+5 WRITE !
SET DA(1)=1
SET DIC("A")="Select Print Mgrs. Queuing Params. Name: "
SET DIC="^IBD(357.09,"_DA(1)_","_"""Q"""_","
SET DIC(0)="AELQMN"
SET DIC("DR")=".01"
SET DLAYGO=357.09
DO ^DIC
KILL DIC
if Y<1
GOTO REP
SET DA=+Y
Begin DoDot:1
+6 SET DA(1)=1
SET DIE="^IBD(357.09,"_DA(1)_","_"""Q"""_","
SET DA=DA
+7 SET DR=".04//"_1_";.05//"_"NO"_";.06"_";.07//"_5_";.08//"_"R"_";.09"_";.1//"_10_";.13//"_0000
+8 DO ^DIE
KILL DA,DIE,DIC,DR
+9 QUIT
End DoDot:1
REP DO INIT^IBDFPE
SET VALMBCK="R"
QUIT
+1 ;
STAT ; -- Find out the status of the queued job and kill a tasked job
+1 NEW IBDVALM,IBDAT,VALMY,IBDFNODE,IBDFSTAT,IBQUIT
+2 SET VALMBCK=""
+3 DO EN^VALM2($GET(XQORNOD(0)))
if '$ORDER(VALMY(0))
GOTO REP
SET IBDVALM=0
+4 DO FULL^VALM1
SET VALMBCK="R"
+5 FOR IBDVALM=0:0
SET IBDVALM=$ORDER(VALMY(IBDVALM))
if 'IBDVALM
QUIT
SET DA=$SELECT($DATA(IBDTYPE(IBDVALM)):$PIECE(IBDTYPE(IBDVALM),"^",1),1:"")
IF DA]""
Begin DoDot:1
+6 SET DA(1)=1
SET IBDFNODE=^IBD(357.09,DA(1),"Q",DA,0)
DO ASK
if $DATA(IBQUIT)
QUIT
if $DATA(IBDFSTOP)
DO KILL^%ZTLOAD
if '$DATA(IBDFSTOP)&(IBDFSTAT]"")
DO STAT^%ZTLOAD
Begin DoDot:2
+7 DO FULL^VALM1
+8 IF IBDFSTAT']""
WRITE !!,"Status of Queued Job <<< "_$PIECE(IBDFNODE,"^",1)_" >>>",!!,"JOB NOT TASKED!"
if $DATA(IBDFSTOP)
WRITE " NO NEED TO INTERRUPT JOB!"
QUIT
+9 WRITE !!,"Status of Queued Job <<< "_$PIECE(IBDFNODE,"^",1)_" >>>",!!
+10 IF $DATA(ZTSK(0))
WRITE !," TASK: ",$SELECT($DATA(ZTSK):ZTSK,1:"")_" - ",$SELECT(ZTSK(0)=1:"Defined",1:"Undefined")
+11 IF $DATA(ZTSK(1))
WRITE !,"STATUS CODE: ",ZTSK(1)
+12 IF $DATA(ZTSK(2))
WRITE !," STATUS: ",ZTSK(2)
+13 IF $DATA(IBDFSTOP)
if ZTSK(0)=1
WRITE !,"SUCCESSFUL DELETION OF TASK"
WRITE !!,"***JOB STOPPED UPON REQUEST***"
if ZTSK=$PIECE(IBDFNODE,"^",11)
SET $PIECE(^IBD(357.09,DA(1),"Q",DA,0),"^",11)=""
if ZTSK=$PIECE(IBDFNODE,"^",14)
SET $PIECE(^IBD(357.09,DA(1),"Q",DA,0),"^",14)=""
+14 QUIT
End DoDot:2
End DoDot:1
KILL IBQUIT
+15 ;I IBDFSTAT']"" W !!,"Status of Queued Job <<< "_$P(IBDFNODE,"^",1)_" >>>",!!,"JOB NOT TASKED!" I $D(IBDFSTOP) W " NO NEED TO INTERRUPT JOB!"
+16 KILL DA,DA(1)
+17 DO PAUSE^VALM1
DO REP
QUIT
+18 QUIT
+19 ;
DEL ; -- Delete Clinic Group
+1 NEW IBDVALM,VALMY,DIR,DIRUT,DUOUT
+2 SET VALMBCK=""
+3 DO EN^VALM2($GET(XQORNOD(0)))
if '$ORDER(VALMY(0))
GOTO REP
SET IBDVALM=0
+4 DO FULL^VALM1
SET VALMBCK="R"
+5 ;
+6 FOR IBDVALM=0:0
SET IBDVALM=$ORDER(VALMY(IBDVALM))
if 'IBDVALM
QUIT
SET DA=$SELECT($DATA(IBDTYPE(IBDVALM)):$PIECE(IBDTYPE(IBDVALM),"^",1),1:"")
IF DA]""
Begin DoDot:1
+7 SET DA(1)=1
SET DIK="^IBD(357.09,"_DA(1)_","_"""Q"""_","
+8 WRITE !!,"Paramater Group: "_$PIECE($GET(^IBD(357.09,1,"Q",DA,0)),"^",1)
+9 WRITE !
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are You Sure you want to delete "_$PIECE($GET(^IBD(357.09,1,"Q",DA,0)),"^",1)
+10 DO ^DIR
KILL DIR
IF Y'=1
WRITE !,"Entry ",$PIECE($GET(^IBD(357.09,1,"Q",DA,0)),"^",1)," not Deleted!"
QUIT
+11 DO DP1
End DoDot:1
+12 ;
DELQ DO REP
+1 SET VALMBCK="R"
QUIT
+2 ;
DP1 ; -- actual deletion
+1 SET DIK="^IBD(357.09,"_DA(1)_","_"""Q"""_","
DO ^DIK
+2 WRITE !,"Entry ",IBDVALM," Deleted"
+3 QUIT
ASK IF $PIECE(IBDFNODE,"^",11)']""!($PIECE(IBDFNODE,"^",14)']"")!($PIECE(IBDFNODE,"^",11)=$PIECE(IBDFNODE,"^",14))
Begin DoDot:1
+1 SET (IBDFSTAT,ZTSK)=$PIECE(IBDFNODE,"^",11)
+2 QUIT
End DoDot:1
QUIT
+3 SET DIR(0)="S^1:CURRENT;2:PREVIOUS"
+4 SET DIR("A")="Select action for print group "_$PIECE(IBDFNODE,"^",1)
+5 SET DIR("B")="CURRENT"
+6 SET DIR("?")=" "
+7 SET DIR("?",1)="Choose 1 or 'C' CURRENT TASK"
+8 SET DIR("?",2)=" or"
+9 SET DIR("?",3)=" 2 or 'P' for PREVIOUS TASK"
+10 SET DIR("?",4)=" "
+11 SET DIR("?",5)=" Current task # ="_$PIECE(IBDFNODE,"^",11)
+12 SET DIR("?",6)=" "
+13 SET DIR("?",7)=" Previous task # = "_$PIECE(IBDFNODE,"^",14)
+14 DO ^DIR
+15 IF $DATA(DTOUT)!($DATA(DUOUT))
SET IBQUIT=1
+16 SET (IBDFSTAT,ZTSK)=$SELECT(Y=2:$PIECE(IBDFNODE,"^",14),1:$PIECE(IBDFNODE,"^",11))
+17 KILL DIR
QUIT
