source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF15A.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1IBDF15A ;ALB/CJM - AICS FORM USE BY DIVISION/CLINIC ; JUL 20,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4 ; -- prints for each encounter form the clinics using it
5 ;
6PRINT ; -- Main print driver
7 W:$E(IOST,1,2)="C-" @IOF
8 S FORMNAM="" F S FORMNAM=$O(^IBE(357,"B",FORMNAM)) Q:FORMNAM="" S FORM=$O(^IBE(357,"B",FORMNAM,0)) Q:'FORM D Q:IBQUIT
9 .Q:$P($G(^IBE(357,FORM,0)),"^",7) ;exclude toolkit forms
10 .D CLINIC(FORM,FORMNAM)
11 D LIST
12 I $E(IOST,1,2)="C-",'IBQUIT D PAUSE
13 Q
14 ;
15CLINIC(FORM,FORMNAM) ;
16 ; -- finds the list of clinics using FORM
17 ; ^TMP($J,"IBDCS",0) is number of clinics found
18 ; ^TMP($J,"IBDCS",divname, div pointer, form name, form pointer,
19 ; clinic name)=clinic pointer := is list of clinics
20 ;
21 N CLINIC,SETUP,IDX,CLNAME,DIVIS,DIVNAM,CNT
22 F IDX="C","D","E","F","G","H","I","J" D
23 .S SETUP="" F S SETUP=$O(^SD(409.95,IDX,FORM,SETUP)) Q:'SETUP D
24 ..S CLINIC=$P($G(^SD(409.95,SETUP,0)),"^",1)
25 ..Q:'CLINIC
26 ..S CLNAME=$P($G(^SC(CLINIC,0)),"^",1)
27 ..Q:CLNAME=""
28 ..S DIVIS=$P($G(^SC(CLINIC,0)),"^",15)
29 ..I DIVIS="" S DIVIS=$S(MULTI=0:$$PRIM^VASITE,1:"Unknown")
30 ..S DIVNAM=$P($G(^DG(40.8,+DIVIS,0)),"^")
31 ..S:DIVNAM="" DIVNAM="Unknown"
32 ..S CNT=$G(CNT)+1
33 ..S ^TMP($J,"IBDCS",DIVNAM,+$G(DIVIS),FORMNAM,FORM,CLNAME)=CLINIC_"^"_IDX
34 ..S ^TMP($J,"IBDCS",DIVNAM,+$G(DIVIS))=$G(^TMP($J,"IBDCS",DIVNAM,+$G(DIVIS)))+1
35 S:$G(CNT)<1 ^TMP($J,"IBDCN",FORMNAM,FORM)="" ;forms not in use
36 Q
37 ;
38LIST ; -- lists the clinics using FORM
39 N DIVNAM,DIVIS,FORMNAM,FORM,CLNAME,CLINIC,NEWDIV,IBDONE,IDX
40 ;
41 ; -- list forms not in use
42 S DIVNAM="",NEWDIV=0
43 F S DIVNAM=$O(^TMP($J,"IBDCS",DIVNAM)) Q:DIVNAM=""!(IBQUIT) S DIVIS=+$O(^TMP($J,"IBDCS",DIVNAM,"")) I VAUTD=1!($D(VAUTD(DIVIS))) D
44 .;
45 .S NEWDIV=1
46 .K IBDONE
47 .S FORMNAM=""
48 .F S FORMNAM=$O(^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM)) Q:FORMNAM=""!(IBQUIT) S FORM=$O(^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM,0)) D
49 ..;
50 ..S CLNAME=""
51 ..F S CLNAME=$O(^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM,FORM,CLNAME)) Q:CLNAME=""!(IBQUIT) S CLINIC=+^(CLNAME),IDX=$P(^(CLNAME),"^",2) I '$D(IBDONE(FORM)) W ! D LINEONE,ALL(FORMNAM,CLNAME,DIVNAM)
52 ;
53 ; -- list forms not in use
54 S FORMNAM="",NEWDIV=1,DIVNAM="FORMS NOT IN USE"
55 F S FORMNAM=$O(^TMP($J,"IBDCN",FORMNAM)) Q:FORMNAM=""!(IBQUIT) S FORM=$O(^TMP($J,"IBDCN",FORMNAM,0)) D LINETWO
56 Q
57 ;
58LINEONE ; -- print on report header, lines, etc.
59 ;
60 I NEWDIV D HEADER Q:IBQUIT W !,?10,"Division: ",DIVNAM S NEWDIV=0
61 I $Y>(IOSL-3) D HEADER Q:IBQUIT
62 W !,FORMNAM,?32,$E(CLNAME,1,25),?59,$E(DIVNAM,1,20),?81,$$TYPE(IDX)
63 I '$$ACLN^IBDFCNOF(CLINIC) W ?100," (Clinic Currently Inactive)"
64 S IBDONE(FORM)=""
65 Q
66 ;
67LINETWO ; -- print lines for forms not in use
68 I NEWDIV D HEADER Q:IBQUIT S NEWDIV=0
69 I $Y>(IOSL-3) D HEADER Q:IBQUIT
70 W !,FORMNAM,?32,"** NOT IN USE **"
71 Q
72 ;
73LINETHR ; -- print lines for clinics in other divisions
74 I $Y>(IOSL-3) D HEADER Q:IBQUIT
75 W !,?32,CLNAME,?59,$E(DIVNAM,1,20),?81,$$TYPE(IDX)
76 I '$$ACLN^IBDFCNOF(CLINIC) W ?100," (Clinic Currently Inactive)"
77 Q
78 ;
79ALL(FORMNAM,CL1,DV1) ;
80 ; -- find all clinics using for irregardless of division
81 ; stored in ^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM,FORM,CLNAME)
82 ;
83 N FORM,CLNAME,DIVNAM,DIVIS
84 S DIVNAM=""
85 F S DIVNAM=$O(^TMP($J,"IBDCS",DIVNAM)) Q:DIVNAM=""!(IBQUIT) S DIVIS=+$O(^TMP($J,"IBDCS",DIVNAM,"")) I VAUTD=1!($D(VAUTD(DIVIS))) D
86 .S FORM=+$O(^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM,0))
87 .S CLNAME="" F S CLNAME=$O(^TMP($J,"IBDCS",DIVNAM,DIVIS,FORMNAM,FORM,CLNAME)) Q:CLNAME=""!(IBQUIT) S CLINIC=+^(CLNAME) D
88 ..Q:CL1=CLNAME&(DV1=DIVNAM)
89 ..D LINETHR
90 Q
91 ;
92 ;S FORM=$O(^TMP($J,"IBDCL",FORMNAM,0))
93 ;S CLNAME="" F S CLNAME=$O(^TMP($J,"IBDCL",FORMNAM,FORM,CLNAME)) Q:CLNAME=""!(IBQUIT) D
94 ;.S DIVNAM="" F S DIVNAM=$O(^TMP($J,"IBDCL",FORMNAM,FORM,CLNAME,DIVNAM)) Q:DIVNAM=""!(IBQUIT) D
95 ;..Q:CL1=CLNAME&(DV1=DIVNAM)
96 ;..D LINETHR
97 Q
98 ;
99HEADER ; -- writes the report header
100 I $E(IOST,1,2)="C-",$Y>1,PAGE>1 D PAUSE Q:IBQUIT
101 I PAGE>1 W @IOF
102 W !,"List of Encounter Forms and their Use by Clinics",?IOM-30,IBHDT," PAGE ",PAGE
103 W !,"For Division: ",$G(DIVNAM)
104 W !,"FORM NAME",?32,"CLINIC",?59,"DIVISION",?81,"FORM USAGE"
105 W !,$TR($J(" ",IOM)," ","-")
106 S PAGE=PAGE+1
107 Q
108 ;
109PAUSE ; -- hold screen
110 N DIR,X,Y
111 F Q:$Y>(IOSL-2) W !
112 S DIR(0)="E" D ^DIR S IBQUIT=$S(+Y:0,1:1)
113 Q
114 ;
115TYPE(IDX) ;
116 ; -- type of form
117 ; input cross reference from print Manager Clinic Setups (409.95)
118 ; output name of type of form
119 ; IDX="C","D","E","F","G","H","I","J"
120 ;
121 N X
122 S IDX=$E(IDX,1)
123 S X="" I IDX="" G TYPEQ
124 S X=$S(IDX="C":"Basic Form",IDX="D":"Supplmntl form - Establshed Pt.",IDX="E":"Supplmntl Form - First Visit",IDX="F":"Form w/o Patient Data",IDX="G":"Supplmntl Form #1",1:"")
125 I X="" S X=$S(IDX="H":"Reserved",IDX="I":"Supplmntl Form #2",IDX="J":"Supplmntl Form #3",1:"")
126TYPEQ Q X
Note: See TracBrowser for help on using the repository browser.