source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF1B5.m@ 1635

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1IBDF1B5 ;ALB/CJM - ENCOUNTER FORM - (prints reports defined by print manager); 5/15/93
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4PRNTOTHR(CLINIC,APPT,DFN) ;prints reports defined for CLINIC/DIVISION
5 ; -- input CLINIC = ien file 44
6 ; -- APPT = pts appointment date in fm format
7 ; -- DFN = ptr to pt file
8 Q:'CLINIC!('APPT)!('DFN)
9 N DIVISION,RPT,IBDIV,IBCLIN
10 S DIVISION=+$$DIVISION(CLINIC)
11 ; -- build arrays of reports to print
12 D DIV(DIVISION,.IBDIV),CLIN(CLINIC,.IBCLIN)
13 ; -- go through clinic reports and print
14 S RPT=0 F S RPT=$O(IBCLIN(RPT)) Q:'RPT I '$$EXCLUDE(CLINIC,RPT) D PRINT(RPT,$P(IBCLIN(RPT),"^",2))
15 ; -- go through division reports
16 S RPT=0 F S RPT=$O(IBDIV(RPT)) Q:'RPT I '$$EXCLUDE(CLINIC,RPT) D
17 .N RULE,RNAR
18 .Q:$D(IBCLIN(RPT)) ; already defined for clinic (clinic overrides div)
19 .S RULE=+IBDIV(RPT),RNAR=$G(^IBE(357.92,+RULE,0)) ; set rule and narrative
20 .I RNAR["MULTIPLE",'$$MULTIPLE^IBDF1B1A(DFN,$E(IBAPPT,1,7)) Q ; if rule=print for multiple appts and pt does not have multiple appts that day, quit
21 .I RNAR["EARLIEST",'$$EARLIEST(DFN,DIVISION,IBAPPT,RPT) Q ;if rule=print for earliest appt that does not exclude, and this is not the earliest appt that includes the rpt, quit
22 .D PRINT(RPT,$P(IBDIV(RPT),"^",2))
23 Q
24 ;
25DIV(DIVISION,DIV) ; -- builds array of reports to print for division
26 ; -- input DIVISION = ien from 40.8
27 ; -- DIV = name of array to pass back
28 ; -- output array in format DIV(ien of report)=""
29 N TYPE,RTN,SETUP,RPT
30 Q:'DIVISION
31 F TYPE=0:0 S TYPE=$O(^SD(409.96,"A",DIVISION,TYPE)) Q:'TYPE F RTN=0:0 S RTN=$O(^SD(409.96,"A",DIVISION,TYPE,RTN)) Q:'RTN F SETUP=0:0 S SETUP=$O(^SD(409.96,"A",DIVISION,TYPE,RTN,SETUP)) Q:'SETUP D
32 .S RPT=0 F S RPT=$O(^SD(409.96,"A",DIVISION,TYPE,RTN,SETUP,RPT)) Q:'RPT S DIV(+$G(^SD(409.96,SETUP,1,RPT,0)))=$P($G(^SD(409.96,SETUP,1,RPT,0)),"^",2,3)
33 Q
34 ;
35CLIN(CLINIC,CLIN) ; -- builds array of reports to print for clinic
36 ; -- input CLINIC = ien from 44
37 ; -- CLIN = name of array to pass back
38 ; -- output array in format CLIN(ien of report)=""
39 N TYPE,RTN,SETUP,RPT
40 Q:'CLINIC
41 F TYPE=0:0 S TYPE=$O(^SD(409.95,"A",CLINIC,TYPE)) Q:'TYPE S RTN="" F S RTN=$O(^SD(409.95,"A",CLINIC,TYPE,RTN)) Q:'RTN F SETUP=0:0 S SETUP=$O(^SD(409.95,"A",CLINIC,TYPE,RTN,SETUP)) Q:'SETUP D
42 .S RPT=0 F S RPT=$O(^SD(409.95,"A",CLINIC,TYPE,RTN,SETUP,RPT)) Q:'RPT S CLIN(+$G(^SD(409.95,SETUP,1,RPT,0)))=$P($G(^SD(409.95,SETUP,1,RPT,0)),"^",2,3)
43 Q
44 ;
45EXCLUDE(CLINIC,RPT) ;deterine if report is excluded for specified clinic
46 ; -- input CLINIC = ien from file 44
47 ; -- RPT = ien of report
48 ; -- output 1 if report is excluded, 0 if not excluded
49 I 'CLINIC!('RPT) Q 0
50 ;print all the reports defined for the entire division,unless excluded for the clinic
51 Q $S($D(^SD(409.95,"AE",CLINIC,RPT)):1,1:0)
52 ;
53EARLIEST(DFN,DIV,APPT,RPT) ;determine if appt is earliest appt that does
54 ; -- not exclude the report
55 ; -- input DFN = ien file 2
56 ; -- DIV = ien 40.8
57 ; -- APPT = appt we have printed EF for
58 ; -- RPT = ien of report
59 N PRN,APT
60 Q:'DFN!('DIV)!('APPT)!('RPT)
61 K ^TMP("IBDF",$J,"APPT LIST")
62 D GETLIST^IBDF1B1A(DFN,$E(APPT,1,7),DIV)
63 S APT=0 F S APT=$O(^TMP("IBDF",$J,"APPT LIST",DIV,DFN,APT)) Q:'APT S CLINIC=^(APT) D Q:$D(PRN)
64 .Q:$D(^SD(409.95,"AE",CLINIC,RPT))
65 .I APT=APPT S PRN=1 Q
66 .S PRN=0
67 Q $S($D(PRN):PRN,1:1)
68 ;
69PRINT(PI,SIDES) ;fetches the package interface record,prints the report
70 ; -- input PI = ien of report
71 ; -- SIDES=0-simplex, 1-duplex long-edge, 2-duplex short-edge
72 N IBRTN S IBRTN=PI N RTN,RPT
73 D RTNDSCR^IBDFU1B(.IBRTN) ;get the interface description
74 Q:IBRTN("ACTION")'=4 ;quit if the interface isn't the type that prints a report
75 ;health summaries always use the same rtn to print
76 I IBRTN("HSMRY?")=1 Q:'IBRTN("HSMRY") S IBRTN("RTN")="PRNTSMRY^IBDFN5("_IBRTN("HSMRY")_")"
77 N TYPE,DIVISION,CLINIC,QUIT,CLNCNAME,PNAME,PTYPE,TDIGIT
78 ;go to duplex?
79 D
80 .I SIDES=1,IBDEVICE("DUPLEX_LONG")]"" W IBDEVICE("DUPLEX_LONG") Q
81 .I SIDES=2,IBDEVICE("DUPLEX_SHORT")]"" W IBDEVICE("DUPLEX_SHORT") Q
82 .I IBDEVICE("SIMPLEX")]"" W IBDEVICE("SIMPLEX") Q
83 .I $Y W @IOF
84 .I SIDES=0,IBDEVICE("SIMPLEX")]"" W IBDEVICE("SIMPLEX")
85 N A S A=$$DORTN^IBDFU1B(.IBRTN)
86 ;go back to simplex
87 D
88 .I SIDES=1,IBDEVICE("DUPLEX_LONG")]"",IBDEVICE("SIMPLEX")]"" W IBDEVICE("SIMPLEX") Q
89 .I SIDES=2,IBDEVICE("DUPLEX_SHORT")]"",IBDEVICE("SIMPLEX")]"" W IBDEVICE("SIMPLEX") Q
90 Q
91DIVISION(CLINIC) ;returns the clinic's division - format is IEN^division's name
92 N DIV,NAME
93 Q:'$G(CLINIC) ""
94 S DIV=+$P($G(^SC(CLINIC,0)),"^",15)
95 I DIV S NAME=$P($G(^DG(40.8,DIV,0)),"^")
96 I $L($G(NAME)) S DIV=DIV_"^"_NAME
97 E S DIV=""
98 Q DIV
99IFOTHR(CLINIC,TYPE) ; -- returns a 1 if there are reports defined for CLINIC for print condition=TYPE,0 if otherwise
100 N RTN,DIVISION,COUNT
101 S COUNT=0
102 S TYPE=$O(^IBE(357.92,"B",TYPE,"")) Q:'TYPE 0 ;get ien of TYPE
103 S DIVISION=+$$DIVISION(CLINIC)
104 ;counts all the reports defined for the entire division
105 I DIVISION S RTN="" F S RTN=$O(^SD(409.96,"A",DIVISION,TYPE,RTN)) Q:'RTN S:'$D(^SD(409.95,"AE",CLINIC,RTN)) COUNT=COUNT+1 Q:COUNT
106 ;counts all the reports defined for the clinic
107 S RTN="" F S RTN=$O(^SD(409.95,"A",CLINIC,TYPE,RTN)) Q:'RTN S COUNT=COUNT+1 Q:COUNT
108 Q COUNT
Note: See TracBrowser for help on using the repository browser.