- IBDFPE1 ;MAF/ALB - ENCOUNTER FORMS QUEUEING PARAMETERS DISPLAY CONT.; 1 31 94
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;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
- 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,IBDFNODE=^IBD(357.09,DA(1),"Q",DA,0) S (IBDFSTAT,ZTSK)=$P(IBDFNODE,"^",11) I IBDFSTAT]"" D:$D(IBDFSTOP) KILL^%ZTLOAD D:'$D(IBDFSTOP) STAT^%ZTLOAD D
- ..D FULL^VALM1
- ..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***"
- ..Q
- I IBDFSTAT']"" W !!,"Status of Queued Job <<< "_$P(IBDFNODE,"^",1)_" >>>",!!,"JOB NOT TASKED!" I $D(IBDFSTOP) W " NO NEED TO INTERUPT 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
- IBDFPE1 ;MAF/ALB - ENCOUNTER FORMS QUEUEING PARAMETERS DISPLAY CONT.; 1 31 94
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;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
- +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)
- SET (IBDFSTAT,ZTSK)=$PIECE(IBDFNODE,"^",11)
- IF IBDFSTAT]""
- IF $DATA(IBDFSTOP)
- DO KILL^%ZTLOAD
- IF '$DATA(IBDFSTOP)
- DO STAT^%ZTLOAD
- Begin DoDot:2
- +7 DO FULL^VALM1
- +8 WRITE !!,"Status of Queued Job <<< "_$PIECE(IBDFNODE,"^",1)_" >>>",!!
- +9 IF $DATA(ZTSK(0))
- WRITE !," TASK: ",$SELECT($DATA(ZTSK):ZTSK,1:"")_" - ",$SELECT(ZTSK(0)=1:"Defined",1:"Undefined")
- +10 IF $DATA(ZTSK(1))
- WRITE !,"STATUS CODE: ",ZTSK(1)
- +11 IF $DATA(ZTSK(2))
- WRITE !," STATUS: ",ZTSK(2)
- +12 IF $DATA(IBDFSTOP)
- IF ZTSK(0)=1
- WRITE !,"SUCCESSFUL DELETION OF TASK"
- WRITE !!,"***JOB STOPPED UPON REQUEST***"
- +13 QUIT
- End DoDot:2
- End DoDot:1
- +14 IF IBDFSTAT']""
- WRITE !!,"Status of Queued Job <<< "_$PIECE(IBDFNODE,"^",1)_" >>>",!!,"JOB NOT TASKED!"
- IF $DATA(IBDFSTOP)
- WRITE " NO NEED TO INTERUPT JOB!"
- +15 KILL DA,DA(1)
- +16 DO PAUSE^VALM1
- DO REP
- QUIT
- +17 QUIT
- +18 ;
- 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
