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

DGRPTU.m

Go to the documentation of this file. 
  1. DGRPTU ;ALB/RMO - 10-10T Registration - Utilities; 04/25/2003
  1.  ;;5.3;Registration;**108,513,1015**;08/13/93;Build 21
  1.  ;
  1. GETPAT(DGHOWPT,DGADDF,DFN,DGNEWPF) ;Look-up patient
  1.  ; Input  -- DGHOWPT  How was patient entered
  1.  ;                    1   =10-10T registration
  1.  ;           DGADDF   Add new entry flag       (optional)
  1.  ;                    1   =Allow new patient
  1.  ; Output -- DFN      Patient IEN
  1.  ;                    #   =Patient IEN
  1.  ;                    -1  =No patient selected
  1.  ;           DGNEWPF  New patient added flag
  1.  ;                    1   =New patient added
  1.  ;                    Null=Existing patient
  1.  N DD,DIC,DINUM,DLAYGO,DO,X,Y
  1.  S DIC="^DPT(",DIC(0)="AEMQ"
  1.  I $G(DGADDF) S DIC(0)=DIC(0)_"L",DLAYGO=2
  1.  W !! D ^DIC S DFN=+Y,DGNEWPF=$P(Y,U,3) N Y W ! D PAUSE^DG10
  1.  ;If new patient
  1.  I DGNEWPF D
  1.  . N DA,DIE,DR
  1.  . ;Set 'how was patient entered' field
  1.  . I $G(DGHOWPT) S DA=DFN,DIE="^DPT(",DR=".098////"_DGHOWPT D ^DIE
  1.  . ;Invoke code to execute new patient DR string for patient type
  1.  . D NEW^DGRP
  1.  Q
  1.  ;
  1. SETPAR(DGDIV,DGIO,DGASKDEV,DGRPTOUT) ;Set up registration parameters
  1.  ; Input  -- None
  1.  ; Output -- DGDIV    Primary Medical Center Division IEN
  1.  ;           DGIO     Registration printer array
  1.  ;           DGASKDEV Registration ask device flag
  1.  ;           DGRPTOUT Quit flag
  1.  ;                    1   =Timeout or User up-arrow
  1.  ;Check ADT parameter set-up and user
  1.  D LO^DGUTL
  1.  ;Get primary medical center division IEN
  1.  S DGDIV=$$PRIM^VASITE
  1.  ;Get 1010 printer
  1.  D GETPRT(DGDIV,.DGIO,.DGASKDEV,.DGRPTOUT)
  1. SETPARQ Q
  1.  ;
  1. GETPRT(DGDIV,DGIO,DGASKDEV,DGRPTOUT) ;Get registration printer defaults
  1.  ; Input  -- DGDIV    Primary Medical Center Division IEN
  1.  ; Output -- DGIO     Registration printer array
  1.  ;           DGASKDEV Registration ask device flag
  1.  ;           DGRPTOUT Quit flag
  1.  ;                    -1  =User entered up-arrow
  1.  ;                    -2  =Timeout
  1.  N DGASK,DTOUT,DUOUT,I,POP,Y
  1. ASK ;Ask device in registration
  1.  I $P(^DG(43,1,0),U,39) D  G GETPRTQ:$G(DGRPTOUT),ASK:$G(DGASK)
  1.  . S DGASK=0
  1.  . S:DGDIV %ZIS("B")=$P($G(^DG(40.8,+DGDIV,"DEV")),U,1)
  1.  . S %ZIS="NQ",%ZIS("A")="Select 1010 printer: "
  1.  . W ! D ^%ZIS I POP S DGRPTOUT=$S($D(DTOUT):-2,1:-1) Q
  1.  . I $E(IOST,1,2)'["P-" W !,*7,"Not a printer" S DGASK=1 Q
  1.  . S (DGIO(10),DGIO("PRF"),DGIO("RT"),DGIO("HS"))=ION,DGASKDEV=1
  1.  ;Use closest printer
  1.  I '$D(DGIO),$P(^DG(43,1,0),U,30) D
  1.  . S %ZIS="N",IOP="HOME"
  1.  . D ^%ZIS
  1.  . I $D(IOS),IOS,$D(^%ZIS(1,+IOS,99)),$D(^%ZIS(1,+^(99),0)) S Y=$P(^(0),U,1) D
  1.  . . W !,"Using closest printer ",Y,!
  1.  . . F I=10,"PRF","RT","HS" S DGIO(I)=Y
  1.  ;Use 10-10 printer for division
  1.  I '$D(DGIO),$P($G(^DG(40.8,DGDIV,"DEV")),U,1)'="" S DGIO(10)=$P(^("DEV"),U,1)
  1.  ;Reset home device
  1.  D HOME^%ZIS
  1. GETPRTQ K IO("Q"),%ZIS("B")
  1.  Q
  1.  ;
  1. ELGCHK(DFN) ;Eligibility check for editing
  1.  ; Input  -- DFN      Patient IEN
  1.  ; Output -- 0=No and 1=Yes
  1.  N Y
  1.  ;If the elig is not verified, the user can edit
  1.  I $P($G(^DPT(DFN,.361)),U,1)'="V" S Y=1
  1.  ;If the elig is verified the user must hold the DG ELIGIBILITY key
  1.  ;to edit
  1.  I '$G(Y),$S('($D(DUZ)#2):0,'$D(^XUSEC("DG ELIGIBILITY",DUZ)):0,1:1) S Y=1
  1.  Q +$G(Y)