| [613] | 1 | DGRPTU ;ALB/RMO - 10-10T Registration - Utilities; 04/25/2003
|
|---|
| 2 | ;;5.3;Registration;**108,513**;08/13/93
|
|---|
| 3 | ;
|
|---|
| 4 | GETPAT(DGHOWPT,DGADDF,DFN,DGNEWPF) ;Look-up patient
|
|---|
| 5 | ; Input -- DGHOWPT How was patient entered
|
|---|
| 6 | ; 1 =10-10T registration
|
|---|
| 7 | ; DGADDF Add new entry flag (optional)
|
|---|
| 8 | ; 1 =Allow new patient
|
|---|
| 9 | ; Output -- DFN Patient IEN
|
|---|
| 10 | ; # =Patient IEN
|
|---|
| 11 | ; -1 =No patient selected
|
|---|
| 12 | ; DGNEWPF New patient added flag
|
|---|
| 13 | ; 1 =New patient added
|
|---|
| 14 | ; Null=Existing patient
|
|---|
| 15 | N DD,DIC,DINUM,DLAYGO,DO,X,Y
|
|---|
| 16 | S DIC="^DPT(",DIC(0)="AEMQ"
|
|---|
| 17 | I $G(DGADDF) S DIC(0)=DIC(0)_"L",DLAYGO=2
|
|---|
| 18 | W !! D ^DIC S DFN=+Y,DGNEWPF=$P(Y,U,3) N Y W ! D PAUSE^DG10
|
|---|
| 19 | ;If new patient
|
|---|
| 20 | I DGNEWPF D
|
|---|
| 21 | . N DA,DIE,DR
|
|---|
| 22 | . ;Set 'how was patient entered' field
|
|---|
| 23 | . I $G(DGHOWPT) S DA=DFN,DIE="^DPT(",DR=".098////"_DGHOWPT D ^DIE
|
|---|
| 24 | . ;Invoke code to execute new patient DR string for patient type
|
|---|
| 25 | . D NEW^DGRP
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | SETPAR(DGDIV,DGIO,DGASKDEV,DGRPTOUT) ;Set up registration parameters
|
|---|
| 29 | ; Input -- None
|
|---|
| 30 | ; Output -- DGDIV Primary Medical Center Division IEN
|
|---|
| 31 | ; DGIO Registration printer array
|
|---|
| 32 | ; DGASKDEV Registration ask device flag
|
|---|
| 33 | ; DGRPTOUT Quit flag
|
|---|
| 34 | ; 1 =Timeout or User up-arrow
|
|---|
| 35 | ;Check ADT parameter set-up and user
|
|---|
| 36 | D LO^DGUTL
|
|---|
| 37 | ;Get primary medical center division IEN
|
|---|
| 38 | S DGDIV=$$PRIM^VASITE
|
|---|
| 39 | ;Get 1010 printer
|
|---|
| 40 | D GETPRT(DGDIV,.DGIO,.DGASKDEV,.DGRPTOUT)
|
|---|
| 41 | SETPARQ Q
|
|---|
| 42 | ;
|
|---|
| 43 | GETPRT(DGDIV,DGIO,DGASKDEV,DGRPTOUT) ;Get registration printer defaults
|
|---|
| 44 | ; Input -- DGDIV Primary Medical Center Division IEN
|
|---|
| 45 | ; Output -- DGIO Registration printer array
|
|---|
| 46 | ; DGASKDEV Registration ask device flag
|
|---|
| 47 | ; DGRPTOUT Quit flag
|
|---|
| 48 | ; -1 =User entered up-arrow
|
|---|
| 49 | ; -2 =Timeout
|
|---|
| 50 | N DGASK,DTOUT,DUOUT,I,POP,Y
|
|---|
| 51 | ASK ;Ask device in registration
|
|---|
| 52 | I $P(^DG(43,1,0),U,39) D G GETPRTQ:$G(DGRPTOUT),ASK:$G(DGASK)
|
|---|
| 53 | . S DGASK=0
|
|---|
| 54 | . S:DGDIV %ZIS("B")=$P($G(^DG(40.8,+DGDIV,"DEV")),U,1)
|
|---|
| 55 | . S %ZIS="NQ",%ZIS("A")="Select 1010 printer: "
|
|---|
| 56 | . W ! D ^%ZIS I POP S DGRPTOUT=$S($D(DTOUT):-2,1:-1) Q
|
|---|
| 57 | . I $E(IOST,1,2)'["P-" W !,*7,"Not a printer" S DGASK=1 Q
|
|---|
| 58 | . S (DGIO(10),DGIO("PRF"),DGIO("RT"),DGIO("HS"))=ION,DGASKDEV=1
|
|---|
| 59 | ;Use closest printer
|
|---|
| 60 | I '$D(DGIO),$P(^DG(43,1,0),U,30) D
|
|---|
| 61 | . S %ZIS="N",IOP="HOME"
|
|---|
| 62 | . D ^%ZIS
|
|---|
| 63 | . I $D(IOS),IOS,$D(^%ZIS(1,+IOS,99)),$D(^%ZIS(1,+^(99),0)) S Y=$P(^(0),U,1) D
|
|---|
| 64 | . . W !,"Using closest printer ",Y,!
|
|---|
| 65 | . . F I=10,"PRF","RT","HS" S DGIO(I)=Y
|
|---|
| 66 | ;Use 10-10 printer for division
|
|---|
| 67 | I '$D(DGIO),$P($G(^DG(40.8,DGDIV,"DEV")),U,1)'="" S DGIO(10)=$P(^("DEV"),U,1)
|
|---|
| 68 | ;Reset home device
|
|---|
| 69 | D HOME^%ZIS
|
|---|
| 70 | GETPRTQ K IO("Q"),%ZIS("B")
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | ELGCHK(DFN) ;Eligibility check for editing
|
|---|
| 74 | ; Input -- DFN Patient IEN
|
|---|
| 75 | ; Output -- 0=No and 1=Yes
|
|---|
| 76 | N Y
|
|---|
| 77 | ;If the elig is not verified, the user can edit
|
|---|
| 78 | I $P($G(^DPT(DFN,.361)),U,1)'="V" S Y=1
|
|---|
| 79 | ;If the elig is verified the user must hold the DG ELIGIBILITY key
|
|---|
| 80 | ;to edit
|
|---|
| 81 | I '$G(Y),$S('($D(DUZ)#2):0,'$D(^XUSEC("DG ELIGIBILITY",DUZ)):0,1:1) S Y=1
|
|---|
| 82 | Q +$G(Y)
|
|---|
