source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF11.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1IBDF11 ;ALB/CJM - ENCOUNTER FORM - (print manager setup) ;April 20,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4CLNCSUP ;edit clinic setup for print manager
5 N CLINIC
6 K DIR S DIR(0)="409.95,.01",DIR("A")="EDIT REPORTS TO PRINT FOR WHICH CLINIC?"
7 D ^DIR K DIR
8 Q:$D(DIRUT)!(+Y<0)
9 S CLINIC=+Y
10 K DA S DA=$O(^SD(409.95,"B",CLINIC,"")) I 'DA D
11 .K DIC,DO,DD,DINUM S DIC="^SD(409.95,",DIC(0)="",X=CLINIC
12 .D FILE^DICN K DIC
13 .S DA=$S(+Y<1:0,1:+Y)
14 Q:'DA
15 K DIE,DR S DIE=409.95
16 S DR="[IBDF PRINT MANAGER]" D ^DIE K DIE,DR,DA
17 Q
18DIVSUP ;edit division setup for print manager
19 N DIVISION
20 W !!,"You can now select reports that should be printed for the entire division",!
21 K DIR S DIR(0)="409.96,.01",DIR("A")="EDIT REPORTS TO PRINT FOR WHICH DIVISION?"
22 D ^DIR K DIR
23 Q:$D(DIRUT)!(+Y<0)
24 S DIVISION=+Y
25 K DA S DA=$O(^SD(409.96,"B",DIVISION,"")) I 'DA D
26 .K DIC,DO,DD,DINUM S DIC="^SD(409.96,",DIC(0)="",X=DIVISION
27 .D FILE^DICN K DIC
28 .S DA=$S(+Y<1:0,1:+Y)
29 Q:'DA
30 K DIE,DR S DIE=409.96
31 S DR="[IBDF PRINT MANAGER]" D ^DIE K DIE,DR,DA
32 Q
33EDITRPRT(HLTHSMRY) ;edit package interface,type=report
34 ;HLTHSMRY=1 if report type is health summary, 0 otherwise
35 N REPORT,IBDELETE,IBNEW,DLAYGO
36 S HLTHSMRY=+$G(HLTHSMRY)
37 W !!,"You can now edit the "_$S(HLTHSMRY:"Health Summaries",1:"reports")_" available through the print manager.",!
38 D:'HLTHSMRY INFO^IBDF11A
39 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
40 S DIC("A")="Select a "_$S(HLTHSMRY:"Health Summary",1:"report")_" defined to the print manager: "
41 S:HLTHSMRY DLAYGO=357.6
42 D ^DIC K DIC
43 Q:+Y<0
44 S REPORT=+Y,IBNEW=$P(Y,"^",3)
45 S IBDELETE=$S(IBNEW:1,1:0)
46 S DA=REPORT
47 K DIE,DR S DIE=357.6,DR=$S(HLTHSMRY:"[IBDF EDIT AVAILABLE HLTH SMRY]",1:"[IBDF EDIT AVAILABLE REPORT]"),DIE("NO^")="BACKOUTOK"
48 D ^DIE K DIE,DR,DA
49 I IBDELETE K DA S DIK="^IBE(357.6,",DA=REPORT D ^DIK K DIK,DA
50 Q
51CLNCSUP2 ;entry point to be called by an action protocol
52 D FULL^VALM1
53 D CLNCSUP
54 S VALMBCK="R"
55 Q
56DIVSUP2 ;entry point to be called by an action protocol
57 D FULL^VALM1
58 D DIVSUP
59 S VALMBCK="R"
60 Q
Note: See TracBrowser for help on using the repository browser.