Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDF1B5

IBDF1B5.m

Go to the documentation of this file. 
  1. IBDF1B5 ;ALB/CJM - ENCOUNTER FORM - (prints reports defined by print manager); 5/15/93
  1.  ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
  1.  ;
  1. PRNTOTHR(CLINIC,APPT,DFN) ;prints reports defined for CLINIC/DIVISION
  1.  ; -- input CLINIC = ien file 44
  1.  ; --       APPT = pts appointment date in fm format
  1.  ; --       DFN = ptr to pt file
  1.  Q:'CLINIC!('APPT)!('DFN)
  1.  N DIVISION,RPT,IBDIV,IBCLIN
  1.  S DIVISION=+$$DIVISION(CLINIC)
  1.  ; -- build arrays of reports to print
  1.  D DIV(DIVISION,.IBDIV),CLIN(CLINIC,.IBCLIN)
  1.  ; -- go through clinic reports and print
  1.  S RPT=0 F  S RPT=$O(IBCLIN(RPT)) Q:'RPT  I '$$EXCLUDE(CLINIC,RPT) D PRINT(RPT,$P(IBCLIN(RPT),"^",2))
  1.  ; -- go through division reports
  1.  S RPT=0 F  S RPT=$O(IBDIV(RPT)) Q:'RPT  I '$$EXCLUDE(CLINIC,RPT) D
  1.  .N RULE,RNAR
  1.  .Q:$D(IBCLIN(RPT))  ; already defined for clinic (clinic overrides div)
  1.  .S RULE=+IBDIV(RPT),RNAR=$G(^IBE(357.92,+RULE,0)) ; set rule and narrative
  1.  .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
  1.  .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
  1.  .D PRINT(RPT,$P(IBDIV(RPT),"^",2))
  1.  Q
  1.  ;
  1. DIV(DIVISION,DIV) ; -- builds array of reports to print for division
  1.  ; -- input DIVISION = ien from 40.8
  1.  ; --       DIV = name of array to pass back
  1.  ; -- output array in format DIV(ien of report)=""
  1.  N TYPE,RTN,SETUP,RPT
  1.  Q:'DIVISION
  1.  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
  1.  .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)
  1.  Q
  1.  ;
  1. CLIN(CLINIC,CLIN) ; -- builds array of reports to print for clinic
  1.  ; -- input CLINIC = ien from 44
  1.  ; --       CLIN = name of array to pass back
  1.  ; -- output array in format CLIN(ien of report)=""
  1.  N TYPE,RTN,SETUP,RPT
  1.  Q:'CLINIC
  1.  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
  1.  .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)
  1.  Q
  1.  ;
  1. EXCLUDE(CLINIC,RPT) ;deterine if report is excluded for specified clinic
  1.  ; -- input CLINIC = ien from file 44
  1.  ; --       RPT = ien of report
  1.  ; -- output 1 if report is excluded, 0 if not excluded
  1.  I 'CLINIC!('RPT) Q 0
  1.  ;print all the reports defined for the entire division,unless excluded for the clinic
  1.  Q $S($D(^SD(409.95,"AE",CLINIC,RPT)):1,1:0)
  1.  ;
  1. EARLIEST(DFN,DIV,APPT,RPT) ;determine if appt is earliest appt that does
  1.  ; -- not exclude the report
  1.  ; -- input DFN = ien file 2
  1.  ; --       DIV = ien 40.8
  1.  ; --       APPT = appt we have printed EF for
  1.  ; --       RPT = ien of report
  1.  N PRN,APT
  1.  Q:'DFN!('DIV)!('APPT)!('RPT)
  1.  K ^TMP("IBDF",$J,"APPT LIST")
  1.  D GETLIST^IBDF1B1A(DFN,$E(APPT,1,7),DIV)
  1.  S APT=0 F  S APT=$O(^TMP("IBDF",$J,"APPT LIST",DIV,DFN,APT)) Q:'APT  S CLINIC=^(APT) D  Q:$D(PRN)
  1.  .Q:$D(^SD(409.95,"AE",CLINIC,RPT))
  1.  .I APT=APPT S PRN=1 Q
  1.  .S PRN=0
  1.  Q $S($D(PRN):PRN,1:1)
  1.  ;
  1. PRINT(PI,SIDES) ;fetches the package interface record,prints the report
  1.  ; -- input PI = ien of report
  1.  ; --       SIDES=0-simplex, 1-duplex long-edge, 2-duplex short-edge
  1.  N IBRTN S IBRTN=PI N RTN,RPT
  1.  D RTNDSCR^IBDFU1B(.IBRTN) ;get the interface description
  1.  Q:IBRTN("ACTION")'=4  ;quit if the interface isn't the type that prints a report
  1.  ;health summaries always use the same rtn to print
  1.  I IBRTN("HSMRY?")=1 Q:'IBRTN("HSMRY")  S IBRTN("RTN")="PRNTSMRY^IBDFN5("_IBRTN("HSMRY")_")"
  1.  N TYPE,DIVISION,CLINIC,QUIT,CLNCNAME,PNAME,PTYPE,TDIGIT
  1.  ;go to duplex?
  1.  D
  1.  .I SIDES=1,IBDEVICE("DUPLEX_LONG")]"" W IBDEVICE("DUPLEX_LONG") Q
  1.  .I SIDES=2,IBDEVICE("DUPLEX_SHORT")]"" W IBDEVICE("DUPLEX_SHORT") Q
  1.  .I IBDEVICE("SIMPLEX")]"" W IBDEVICE("SIMPLEX") Q
  1.  .I $Y W @IOF
  1.  .I SIDES=0,IBDEVICE("SIMPLEX")]"" W IBDEVICE("SIMPLEX")
  1.  N A S A=$$DORTN^IBDFU1B(.IBRTN)
  1.  ;go back to simplex
  1.  D
  1.  .I SIDES=1,IBDEVICE("DUPLEX_LONG")]"",IBDEVICE("SIMPLEX")]"" W IBDEVICE("SIMPLEX") Q
  1.  .I SIDES=2,IBDEVICE("DUPLEX_SHORT")]"",IBDEVICE("SIMPLEX")]"" W IBDEVICE("SIMPLEX") Q
  1.  Q
  1. DIVISION(CLINIC) ;returns the clinic's division - format is IEN^division's name
  1.  N DIV,NAME
  1.  Q:'$G(CLINIC) ""
  1.  S DIV=+$P($G(^SC(CLINIC,0)),"^",15)
  1.  I DIV S NAME=$P($G(^DG(40.8,DIV,0)),"^")
  1.  I $L($G(NAME)) S DIV=DIV_"^"_NAME
  1.  E  S DIV=""
  1.  Q DIV
  1. IFOTHR(CLINIC,TYPE) ; -- returns a 1 if there are reports defined for CLINIC for print condition=TYPE,0 if otherwise
  1.  N RTN,DIVISION,COUNT
  1.  S COUNT=0
  1.  S TYPE=$O(^IBE(357.92,"B",TYPE,"")) Q:'TYPE 0 ;get ien of TYPE
  1.  S DIVISION=+$$DIVISION(CLINIC)
  1.  ;counts all the reports defined for the entire division
  1.  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
  1.  ;counts all the reports defined for the clinic
  1.  S RTN="" F  S RTN=$O(^SD(409.95,"A",CLINIC,TYPE,RTN)) Q:'RTN  S COUNT=COUNT+1 Q:COUNT
  1.  Q COUNT