| 1 | IBDF1B5 ;ALB/CJM - ENCOUNTER FORM - (prints reports defined by print manager); 5/15/93
|
---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
---|
| 3 | ;
|
---|
| 4 | PRNTOTHR(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 | ;
|
---|
| 25 | DIV(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 | ;
|
---|
| 35 | CLIN(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 | ;
|
---|
| 45 | EXCLUDE(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 | ;
|
---|
| 53 | EARLIEST(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 | ;
|
---|
| 69 | PRINT(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
|
---|
| 91 | DIVISION(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
|
---|
| 99 | IFOTHR(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
|
---|