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

DGPLBL.m

Go to the documentation of this file.
  1. DGPLBL ;ALB/RPM - PATIENT INFORMATION LABELS ; 05/07/04
  1. ;;5.3;Registration;**571**;Aug 13, 1993
  1. ;
  1. ;This routine provides a generic patient demographics label
  1. ;print that includes Patient Name, SSN, DOB and an optional
  1. ;inpatient location (ward and bed). Support for various printer
  1. ;types (i.e. bar code, laser, etc.) is provided using the CONTROL
  1. ;CODES (#3.2055) subfile of the TERMINAL TYPE (#3.2) file. The
  1. ;control code mnemonics are documented in DBIA# 3435.
  1. ;
  1. Q ;no direct entry
  1. ;
  1. EN ;main entry point used by DG PRINT PATIENT LABEL option
  1. ;
  1. N DGDFNS ;selected patients array
  1. N DGIOCC ;control codes array
  1. N DGLBCNT ;label count
  1. N DGLPL ;lines per label
  1. N DGLOC ;include location flag (0 or 1)
  1. N DGQVAR ;queuing variables
  1. ;
  1. ;select list of patients to print
  1. Q:'$$SELPATS("DGDFNS")
  1. ;
  1. S DGLOC=$$ASK("Include Inpatient Location on Label","Y","YES","Answer YES to include the inpatient ward and bed location on the label")
  1. Q:(DGLOC<0)
  1. ;
  1. S DGLBCNT=$$ASK("Number of Labels per patient",1,"NO^1:250:0","Enter the number of labels to print per patient, from 1 to 250")
  1. Q:(DGLBCNT<0)
  1. ;
  1. S DGLPL=$$ASK("Number of Lines per Label",6,"NO^6:25:0","Enter the total number of lines that the label stock can contain (6-25)")
  1. Q:(DGLPL<0)
  1. ;
  1. ;
  1. ;init queued variables and select output device
  1. S DGQVAR("DGDFNS(")=""
  1. S DGQVAR("DGLBCNT")=""
  1. S DGQVAR("DGLPL")=""
  1. S DGQVAR("DGLOC")=""
  1. D EN^XUTMDEVQ("START^DGPLBL","DG PRINT PATIENT LABEL",.DGQVAR)
  1. Q
  1. ;
  1. START ;retrieve label field data and print labels
  1. ;
  1. ; Input:
  1. ; DGDFNS - array subscripted by pointer to PATIENT (#2) file
  1. ; DGLBCNT - number of labels to print per patient
  1. ; DGLPL - number of lines per label
  1. ; DGLOC - print ward location flag
  1. ;
  1. ; Output:
  1. ; none
  1. ;
  1. N DGDFN ;pointer to PATIENT file
  1. N DGI,DGJ ;generic counters
  1. N DGIOCC ;printer Control Codes
  1. N DGLN ;line array index
  1. N DGLNCNT ;line count
  1. N DGLINE ;line text
  1. ;
  1. ;initialize printer
  1. S DGIOCC=$$LOADCC(.DGIOCC)
  1. I DGIOCC,$G(DGIOCC("FI"))]"" X DGIOCC("FI") ;format initialize
  1. ;
  1. ;for each patient
  1. S DGDFN=0
  1. F S DGDFN=$O(DGDFNS(DGDFN)) Q:'DGDFN D
  1. . ;
  1. . ;build text line array
  1. . S DGLNCNT=$$BLDLNAR(DGDFN,DGLOC,.DGLINE)
  1. . Q:'DGLNCNT
  1. . ;
  1. . ;print patient's labels
  1. . F DGI=1:1:DGLBCNT D
  1. . . I DGIOCC,$G(DGIOCC("SL"))]"" X DGIOCC("SL") ;start of label
  1. . . ;for each line
  1. . . F DGLN=1:1:DGLNCNT D
  1. . . . I DGIOCC,$G(DGIOCC("ST"))]"" X DGIOCC("ST") ;start text
  1. . . . I DGIOCC,$G(DGIOCC("STF"))]"" X DGIOCC("STF") ;start text field
  1. . . . W $G(DGLINE(DGLN))
  1. . . . I DGIOCC,$G(DGIOCC("ETF"))]"" X DGIOCC("ETF") ;end text field
  1. . . . I DGIOCC,$G(DGIOCC("ET"))]"" X DGIOCC("ET") ;end text
  1. . . . I 'DGIOCC W !
  1. . . I DGIOCC,$G(DGIOCC("EL"))]"" X DGIOCC("EL") ;end of label
  1. . . I 'DGIOCC,DGLNCNT<DGLPL F DGJ=1:1:(DGLPL-DGLNCNT) W !
  1. I DGIOCC,$G(DGIOCC("FE"))]"" X DGIOCC("FE") ;format end
  1. ;
  1. D END
  1. ;
  1. Q
  1. ;
  1. SELPATS(DGARR) ;select patient(s) to print
  1. ;
  1. ; Input:
  1. ; DGARR - array name to contain returned patients
  1. ;
  1. ; Output:
  1. ; Function value - 1 on success; 0 on failure
  1. ; DGARR - array of returned patients on success
  1. ;
  1. N DIC ;FM file reference
  1. N VAUTVB ;contains name of subscripted variable to return
  1. N VAUTNALL ;define to prevent "ALL" option
  1. N VAUTSTR ;prompt string following "Select "
  1. N VAUTNI ;sort type flag [1:alpha if .01 not pointer,2:numeric,
  1. ; 3:alpha]
  1. ;
  1. S DIC="^DPT(",VAUTVB=DGARR,VAUTNALL=1,VAUTNI=2,VAUTSTR="PATIENT"
  1. D FIRST^VAUTOMA
  1. Q $S($O(@DGARR@("")):1,1:0)
  1. ;
  1. ;
  1. ASK(DGDIRA,DGDIRB,DGDIR0,DGDIRH) ;
  1. ; Input
  1. ; DGDIR0 - DIR(0) string
  1. ; DGDIRA - DIR("A") string
  1. ; DGDIRB - DIR("B") string
  1. ; DGDIRH - DIR("?") string
  1. ;
  1. ; Output
  1. ; Function Value - Internal value returned from ^DIR or -1 if user
  1. ; up-arrows, double up-arrows or the read times out.
  1. ;
  1. ; DIR(0) type Results
  1. ; ------------ -------------------------------
  1. ; DD IEN of selected entry
  1. ; Numeric Value of number entered by user
  1. ; Pointer IEN of selected entry
  1. ; Set of Codes Internal value of code
  1. ; Yes/No 0 for No, 1 for Yes
  1. ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
  1. ;
  1. S DIR(0)=DGDIR0
  1. S DIR("A")=$G(DGDIRA)
  1. I $G(DGDIRB)]"" S DIR("B")=DGDIRB
  1. I $G(DGDIRH)]"" S DIR("?")=DGDIRH
  1. D ^DIR
  1. Q $S($D(DUOUT):-1,$D(DTOUT):-1,$D(DIROUT):-1,X="@":"@",1:$P(Y,U))
  1. ;
  1. ;
  1. LOADCC(DGIOCC) ;load control code mnemonics array
  1. ; This function loads values from the CONTROL CODE (#2) subfield of
  1. ; the CONTROL CODES (#55) field of the TERMINAL TYPE (#3.2) file into
  1. ; an array subscripted by the CONTROL CODE ABBREVIATION (#.01) subfield
  1. ; value.
  1. ;
  1. ; Controlled Subscription DBIA: #3435 CONTROL CODES SUBFILE
  1. ;
  1. ; Input:
  1. ; DGIOCC - variable name to contain control codes array
  1. ;
  1. ; Output:
  1. ; Function value - 1 when control codes exist, 0 when no control
  1. ; codes exist
  1. ; DGIOCC - array of control codes
  1. ;
  1. N DGI ;generic counter
  1. N DGMNE ;control code abbreviation
  1. ;
  1. S DGI=0
  1. F S DGI=$O(^%ZIS(2,IOST(0),55,DGI)) Q:'DGI D
  1. . S DGMNE=$P($G(^%ZIS(2,IOST(0),55,DGI,0)),U)
  1. . I DGMNE]"" S DGIOCC(DGMNE)=^%ZIS(2,IOST(0),55,DGI,1)
  1. ;
  1. Q $S('$D(DGIOCC):0,1:1)
  1. ;
  1. BLDLNAR(DGDFN,DGLOC,DGTEXT) ;build array of text lines
  1. ;
  1. ; Input:
  1. ; DGDFN - pointer to patient in PATIENT (#2) file
  1. ; DGLOC - inpatient location flag
  1. ;
  1. ; Output:
  1. ; Function value - count of returned lines on success; 0 on failure
  1. ; DGTEXT - numeric subscripted array of label text lines
  1. ;
  1. N DFN,VA,VADM,VAERR ;VADPT variables
  1. N DGI ;line counter
  1. ;
  1. S DGI=0
  1. ;
  1. I +$G(DGDFN),$D(^DPT(DGDFN,0)) D
  1. . S DFN=DGDFN
  1. . D DEM^VADPT
  1. . S DGI=DGI+1
  1. . S DGTEXT(DGI)="Name: "_$G(VADM(1))
  1. . S DGI=DGI+1
  1. . S DGTEXT(DGI)=" SSN: "_$P($G(VADM(2)),U,2)
  1. . S DGI=DGI+1
  1. . S DGTEXT(DGI)=" DOB: "_$$FMTE^XLFDT($P($G(VADM(3)),U),"5Z")
  1. . ;WARD LOCATION and ROOM-BED
  1. . S DGI=DGI+1
  1. . S DGTEXT(DGI)=$S(DGLOC:"Ward: "_$S($D(^DPT(DFN,.1)):^DPT(DFN,.1)_" "_$G(^DPT(DFN,.101)),1:"UNKNOWN"),1:"")
  1. ;
  1. Q DGI
  1. ;
  1. END ;cleanup and close device
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. E D ^%ZISC
  1. Q