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

BDGCRB.m

Go to the documentation of this file. 
  1. BDGCRB ; IHS/ANMC/LJF - CLINICAL RECORD BRIEF ; 
  1.  ;;5.3;PIMS;**1007,1008**;APR 26, 2002
  1.  ;
  1.  ;
  1.  ;cmi/anch/maw 7/25/2007 added set of copies to 1 if in quiet mode or bombs in BDGCRB1
  1.  ;
  1.  ;
  1. FORMS ;EP; entry point for admission forms option
  1.  NEW FORM,CHOICE,DGPMT
  1.  K BDGFRM,BDGHALF,BDGCOP,BDGFIN,DGQUIET,DGPMCA,DFN
  1.  ;
  1.  I $D(^XUSEC("DGZNOCLN",DUZ)) D  Q
  1.  . W !!,"LOCATOR CARD",!!
  1.  . S FORM=1,DGPMT=1 D NOPAT^BDGLOC(1)
  1.  ;
  1.  S CHOICE="1:Locator Card;2:A Sheet;3:A Sheets by Admit Date"
  1.  I $D(^XUSEC("DGZPCC2",DUZ)) S CHOICE=CHOICE_";4:Final A Sheet"
  1.  S FORM=$$READ^BDGF("SO^"_CHOICE,"Select Admission Form to Print")
  1.  S DGPMT=1
  1.  I FORM=1 D NOPAT^BDGLOC(1) Q
  1.  I FORM=2 D NOPAT(0) Q
  1.  I FORM=3 D DATES(0) Q
  1.  I FORM=4 D NOPAT(1)
  1.  Q
  1.  ;
  1.  ;
  1. NOPAT(FINAL) ;EP; entry point where patient is not known
  1.  ; FINAL set to 1 if called by FINAL A SHEET option
  1.  NEW DFN,DGPMCA,BDGHALF
  1.  ;
  1.  ; set patient and admission
  1.  S DFN=+$$READ^BDGF("PO^2:EMQZ","Select Patient") Q:DFN<1
  1.  S DGPMCA=$$ADMIT(DFN) Q:DGPMCA<1
  1.  I '$G(DGPMT) S DGPMT=1
  1.  ;
  1.  I '$G(FINAL) S BDGFIN=0
  1.  ;
  1.  I $G(FINAL) D  Q:'BDGFIN
  1.  . S BDGFIN=$$READ^BDGF("SO^1:A Sheet Only;2:A Sheet with CPT List;3:Medicare/Medicaid A Sheet","Select Report to Print",$$GET1^DIQ(9009020.1,$$DIV^BSDU,.07,"I"),"^D FINHLP^BDGCRB")
  1.  ;
  1.  D PAT(DFN,DGPMCA,BDGFIN,+$G(DGPMT))
  1.  Q
  1.  ;
  1.  ;
  1. PAT(DFN,DGPMCA,BDGFIN,DGPMT,BDGHALF,DGQUIET,BDGCOP,BDGDEV) ;EP; pat & adm are known
  1.  ;
  1.  ; REQUIRED:
  1.  ; DFN = patient ien; DGPMCA = admission ien
  1.  ;
  1.  ; DGPMT = transaction type (1=admission, 2=ward transfer, etc.)
  1.  ;
  1.  ; BDGFIN = 0 if not final a sheet, = 1 for a sheet only,
  1.  ;        = 2 for a sheet & cpt list, = 3 for a sheet & m/m list
  1.  ;
  1.  ; OPTIONAL:
  1.  ; DGQUIET = if set to 1 no user interaction and all other optional
  1.  ;               variables are set
  1.  ; BDGDEV  = print device if sent by calling routine
  1.  ;           otherwise will look for a sheet printer for ward
  1.  ;
  1.  ; REQUIRED IF DGQUIET IS SET:
  1.  ; BDGHALF = 1 to print bottom half of form, = 0 to leave blank
  1.  ;         = 2 assumes printing of coded data
  1.  ; BDGCOP = number of copies to print
  1.  ;
  1.  ;
  1.  I ('DFN)!('DGPMCA)!($G(DGPMT)="") Q
  1.  Q:'$D(^DGPM(DGPMCA,0))     ;quit if admission deleted
  1.  Q:DGPMT'=1                 ;a sheets printed only at admission
  1.  ;
  1.  ; get CRB format from parameter file
  1.  NEW BDGFRM
  1.  S BDGFRM=$$GET1^DIQ(9009020.1,$$DIV^BSDU,.06,"I")
  1.  I 'BDGFRM D  Q
  1.  . Q:$G(DGQUIET)
  1.  . D MSG^BDGF("No Clinical Record Brief format has been defined for this facility",2,1)
  1.  . D PAUSE^BDGF
  1.  ;
  1.  ; if in quiet mode, call ZTLOAD and quit
  1.  I $G(DGQUIET) D  Q
  1.  . I '$G(BDGDEV) S BDGDEV=$$WRDPTR(DFN) Q:'BDGDEV   ;find ward's printer
  1.  . S BDGCOP=1  ;cmi/anch/maw 7/25/2007 set copies to 1 if they are in quiet mode
  1.  . D ZIS^BDGF("F","^BDGCRB1","A SHEET PRINT","DFN;DGPMCA;DGPMDA;BDGFRM;BDGHALF;BDGFIN;BDGCOP",$G(BDGDEV))
  1.  . K BDGCNT,BDGHALF,BDGFIN,BDGCOP,BDGFRM  ;cmi/maw 10/3/2007
  1.  . D ^%ZISC  ;cmi/maw 10/3/2007
  1.  ;
  1.  ; else ask user questions
  1.  D MSG^BDGF("Printing A Sheet for admission. Type ^ to bypass.",2,0)
  1.  I BDGFIN>0 S BDGHALF=2     ;if final a sheet
  1.  E  S BDGHALF=$$READ^BDGF("Y","Print Bottom Half of A Sheet","YES") Q:BDGHALF=U
  1.  S BDGCOP=$$READ^BDGF("N^1:10","Print How Many Copies",1) Q:BDGCOP<1
  1.  ;
  1.  ; then send to print device
  1.  I '$G(BDGDEV) S BDGDEV=$$WRDPTR(DFN) I 'BDGDEV K BDGDEV   ;find ward's printer
  1.  D ZIS^BDGF("PQ","^BDGCRB1","A SHEET PRINT","DFN;DGPMCA;DGPMDA;BDGFRM;BDGHALF;BDGFIN;BDGCOP",$G(BDGDEV))
  1.  K BDGCNT,BDGHALF,BDGFIN,BDGCOP,BDGFRM  ;cmi/maw 10/3/2007
  1.  D ^%ZISC  ;cmi/maw 10/3/2007
  1.  Q
  1.  ;
  1.  ;
  1. ADMIT(DFN) ; ask user to select an admission for patient
  1.  I '$D(^DGPM("APCA",DFN)) W !!?5,"No admissions on file." Q 0
  1.  ;
  1.  ; loop by inverse date to display admissions with most recent first
  1.  NEW IEN,IVDT,COUNT,ADM,Y
  1.  W !!,"Admission(s)" S COUNT=0
  1.  S IVDT=0 F  S IVDT=$O(^DGPM("ATID1",DFN,IVDT)) Q:'IVDT  D
  1.  . S IEN=0 F  S IEN=$O(^DGPM("ATID1",DFN,IVDT,IEN)) Q:'IEN  D
  1.  .. S COUNT=COUNT+1,ADM(COUNT)=IEN             ;save ien by count
  1.  .. W !?5,COUNT,".  ",$$GET1^DIQ(405,IEN,.01)  ;display date by count
  1.  .. S X=$$ADMSRV^BDGF1(IEN,DFN)
  1.  .. W ?35,$S(X["OBSERVATION":"Observation",1:"Hospitalization")
  1.  ;
  1.  I COUNT=1 Q ADM(1)     ;only one, no need to choose
  1.  S Y=$$READ^BDGF("NO^1:"_COUNT,"Select One",1)
  1.  Q +$G(ADM(+Y))
  1.  ;
  1. FINHLP ;EP; help for final sheet sheet format question  
  1.  D MSG^BDGF("Answer 1 to print ONLY the final A Sheet.",2,0)
  1.  D MSG^BDGF("Answer 2 to print the A Sheet and a listing of all CPT codes for admission.",2,0)
  1.  D MSG^BDGF("Answer 3 to print the A Sheet and an abbreviated CPT listing.",2,0)
  1.  Q
  1.  ;
  1.  ;
  1. DATES(BDGFIN) ;Entry Point for printing a sheets by admit date
  1.  NEW BDGDT,BDGHALF,BDGCOP,BDGFRM
  1.  ;
  1.  ; get facility's a sheet format
  1.  S BDGFRM=$$GET1^DIQ(9009020.1,$$DIV^BSDU,.06,"I")
  1.  I 'BDGFRM D  Q
  1.  . Q:$G(DGQUIET)
  1.  . D MSG^BDGF("No Clinical Record Brief format has been defined for this facility",2,1)
  1.  . D PAUSE^BDGF
  1.  ;
  1.  S BDGDT=$$READ^BDGF("DO^::EX","Select Admission Date") Q:BDGDT<1
  1.  S BDGHALF=$$READ^BDGF("Y","Print Bottom Half of A Sheet","YES")
  1.  Q:BDGHALF=U
  1.  S BDGCOP=$$READ^BDGF("N^1:10","Print How Many Copies",1) Q:BDGCOP<1
  1.  ;
  1.  D ZIS^BDGF("PQ","DATEP^BDGCRB","A SHEETS BY DATE","BDGDT;BDGFIN;BDGHALF;BDGCOP;BDGFRM")
  1.  Q
  1.  ;
  1.  ;
  1. DATEP ;EP; entry point for queuing to print a sheets by date
  1.  ; Assumes BDGDT, BDGHALF, BDGCOP, BDGFRM  are set
  1.  NEW BDGADT
  1.  S BDGADT=BDGDT-.0001,BDGDT=BDGDT+.24
  1.  F  S BDGADT=$O(^DGPM("AMV1",BDGADT)) Q:'BDGADT  Q:(BDGADT>BDGDT)  D
  1.  . S BDGPAT=0
  1.  . F  S BDGPAT=$O(^DGPM("AMV1",BDGADT,BDGPAT)) Q:'BDGPAT  D
  1.  .. S BDGDA=0
  1.  .. F  S BDGDA=$O(^DGPM("AMV1",BDGADT,BDGPAT,BDGDA)) Q:'BDGDA  D
  1.  ... ;
  1.  ... ; set variables and call ^BDCRB1
  1.  ... S DFN=BDGPAT,DGPMCA=BDGDA,BDGFIN=0
  1.  ... W @IOF
  1.  ... D ^BDGCRB1
  1.  ;
  1.  ; clean up after all have printed
  1.  D ^%ZISC
  1.  K BDGDT,BDGADT,BDGPAT,BDGDA,DFN,DGPMCA,BDGHALF,BDGFRM,BDGCOP
  1.  Q
  1.  ;
  1. WRDPTR(PAT) ; return printer device attached to patient's current ward
  1.  NEW WARD
  1.  S WARD=$$GET1^DIQ(2,PAT,.1) I WARD="" Q 0
  1.  S WARD=$O(^DIC(42,"B",WARD,0)) I 'WARD Q 0
  1.  Q $$GET1^DIQ(9009016.5,WARD,.04)