- 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 Jan 18, 2025@03:51:51 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