IBDF11 ;ALB/CJM - ENCOUNTER FORM - (print manager setup) ;April 20,1993
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
CLNCSUP ;edit clinic setup for print manager
N CLINIC
K DIR S DIR(0)="409.95,.01",DIR("A")="EDIT REPORTS TO PRINT FOR WHICH CLINIC?"
D ^DIR K DIR
Q:$D(DIRUT)!(+Y<0)
S CLINIC=+Y
K DA S DA=$O(^SD(409.95,"B",CLINIC,"")) I 'DA D
.K DIC,DO,DD,DINUM S DIC="^SD(409.95,",DIC(0)="",X=CLINIC
.D FILE^DICN K DIC
.S DA=$S(+Y<1:0,1:+Y)
Q:'DA
K DIE,DR S DIE=409.95
S DR="[IBDF PRINT MANAGER]" D ^DIE K DIE,DR,DA
Q
DIVSUP ;edit division setup for print manager
N DIVISION
W !!,"You can now select reports that should be printed for the entire division",!
K DIR S DIR(0)="409.96,.01",DIR("A")="EDIT REPORTS TO PRINT FOR WHICH DIVISION?"
D ^DIR K DIR
Q:$D(DIRUT)!(+Y<0)
S DIVISION=+Y
K DA S DA=$O(^SD(409.96,"B",DIVISION,"")) I 'DA D
.K DIC,DO,DD,DINUM S DIC="^SD(409.96,",DIC(0)="",X=DIVISION
.D FILE^DICN K DIC
.S DA=$S(+Y<1:0,1:+Y)
Q:'DA
K DIE,DR S DIE=409.96
S DR="[IBDF PRINT MANAGER]" D ^DIE K DIE,DR,DA
Q
EDITRPRT(HLTHSMRY) ;edit package interface,type=report
;HLTHSMRY=1 if report type is health summary, 0 otherwise
N REPORT,IBDELETE,IBNEW,DLAYGO
S HLTHSMRY=+$G(HLTHSMRY)
W !!,"You can now edit the "_$S(HLTHSMRY:"Health Summaries",1:"reports")_" available through the print manager.",!
D:'HLTHSMRY INFO^IBDF11A
K DIC S DIC=357.6,DIC(0)="AELMQ",DIC("S")="I $P($G(^(0)),U,6)=4,"_$S(HLTHSMRY:"$P($G(^(0)),U,10)",1:"'$P($G(^(0)),U,10)"),DLAYGO=357.6
S DIC("A")="Select a "_$S(HLTHSMRY:"Health Summary",1:"report")_" defined to the print manager: "
S:HLTHSMRY DLAYGO=357.6
D ^DIC K DIC
Q:+Y<0
S REPORT=+Y,IBNEW=$P(Y,"^",3)
S IBDELETE=$S(IBNEW:1,1:0)
S DA=REPORT
K DIE,DR S DIE=357.6,DR=$S(HLTHSMRY:"[IBDF EDIT AVAILABLE HLTH SMRY]",1:"[IBDF EDIT AVAILABLE REPORT]"),DIE("NO^")="BACKOUTOK"
D ^DIE K DIE,DR,DA
I IBDELETE K DA S DIK="^IBE(357.6,",DA=REPORT D ^DIK K DIK,DA
Q
CLNCSUP2 ;entry point to be called by an action protocol
D FULL^VALM1
D CLNCSUP
S VALMBCK="R"
Q
DIVSUP2 ;entry point to be called by an action protocol
D FULL^VALM1
D DIVSUP
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF11 2189 printed Dec 13, 2024@02:50:39 Page 2
IBDF11 ;ALB/CJM - ENCOUNTER FORM - (print manager setup) ;April 20,1993
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
CLNCSUP ;edit clinic setup for print manager
+1 NEW CLINIC
+2 KILL DIR
SET DIR(0)="409.95,.01"
SET DIR("A")="EDIT REPORTS TO PRINT FOR WHICH CLINIC?"
+3 DO ^DIR
KILL DIR
+4 if $DATA(DIRUT)!(+Y<0)
QUIT
+5 SET CLINIC=+Y
+6 KILL DA
SET DA=$ORDER(^SD(409.95,"B",CLINIC,""))
IF 'DA
Begin DoDot:1
+7 KILL DIC,DO,DD,DINUM
SET DIC="^SD(409.95,"
SET DIC(0)=""
SET X=CLINIC
+8 DO FILE^DICN
KILL DIC
+9 SET DA=$SELECT(+Y<1:0,1:+Y)
End DoDot:1
+10 if 'DA
QUIT
+11 KILL DIE,DR
SET DIE=409.95
+12 SET DR="[IBDF PRINT MANAGER]"
DO ^DIE
KILL DIE,DR,DA
+13 QUIT
DIVSUP ;edit division setup for print manager
+1 NEW DIVISION
+2 WRITE !!,"You can now select reports that should be printed for the entire division",!
+3 KILL DIR
SET DIR(0)="409.96,.01"
SET DIR("A")="EDIT REPORTS TO PRINT FOR WHICH DIVISION?"
+4 DO ^DIR
KILL DIR
+5 if $DATA(DIRUT)!(+Y<0)
QUIT
+6 SET DIVISION=+Y
+7 KILL DA
SET DA=$ORDER(^SD(409.96,"B",DIVISION,""))
IF 'DA
Begin DoDot:1
+8 KILL DIC,DO,DD,DINUM
SET DIC="^SD(409.96,"
SET DIC(0)=""
SET X=DIVISION
+9 DO FILE^DICN
KILL DIC
+10 SET DA=$SELECT(+Y<1:0,1:+Y)
End DoDot:1
+11 if 'DA
QUIT
+12 KILL DIE,DR
SET DIE=409.96
+13 SET DR="[IBDF PRINT MANAGER]"
DO ^DIE
KILL DIE,DR,DA
+14 QUIT
EDITRPRT(HLTHSMRY) ;edit package interface,type=report
+1 ;HLTHSMRY=1 if report type is health summary, 0 otherwise
+2 NEW REPORT,IBDELETE,IBNEW,DLAYGO
+3 SET HLTHSMRY=+$GET(HLTHSMRY)
+4 WRITE !!,"You can now edit the "_$SELECT(HLTHSMRY:"Health Summaries",1:"reports")_" available through the print manager.",!
+5 if 'HLTHSMRY
DO INFO^IBDF11A
+6 KILL DIC
SET DIC=357.6
SET DIC(0)="AELMQ"
SET DIC("S")="I $P($G(^(0)),U,6)=4,"_$SELECT(HLTHSMRY:"$P($G(^(0)),U,10)",1:"'$P($G(^(0)),U,10)")
SET DLAYGO=357.6
+7 SET DIC("A")="Select a "_$SELECT(HLTHSMRY:"Health Summary",1:"report")_" defined to the print manager: "
+8 if HLTHSMRY
SET DLAYGO=357.6
+9 DO ^DIC
KILL DIC
+10 if +Y<0
QUIT
+11 SET REPORT=+Y
SET IBNEW=$PIECE(Y,"^",3)
+12 SET IBDELETE=$SELECT(IBNEW:1,1:0)
+13 SET DA=REPORT
+14 KILL DIE,DR
SET DIE=357.6
SET DR=$SELECT(HLTHSMRY:"[IBDF EDIT AVAILABLE HLTH SMRY]",1:"[IBDF EDIT AVAILABLE REPORT]")
SET DIE("NO^")="BACKOUTOK"
+15 DO ^DIE
KILL DIE,DR,DA
+16 IF IBDELETE
KILL DA
SET DIK="^IBE(357.6,"
SET DA=REPORT
DO ^DIK
KILL DIK,DA
+17 QUIT
CLNCSUP2 ;entry point to be called by an action protocol
+1 DO FULL^VALM1
+2 DO CLNCSUP
+3 SET VALMBCK="R"
+4 QUIT
DIVSUP2 ;entry point to be called by an action protocol
+1 DO FULL^VALM1
+2 DO DIVSUP
+3 SET VALMBCK="R"
+4 QUIT
