DGRPTU ;ALB/RMO - 10-10T Registration - Utilities; 04/25/2003
;;5.3;Registration;**108,513**;08/13/93
;
GETPAT(DGHOWPT,DGADDF,DFN,DGNEWPF) ;Look-up patient
; Input -- DGHOWPT How was patient entered
; 1 =10-10T registration
; DGADDF Add new entry flag (optional)
; 1 =Allow new patient
; Output -- DFN Patient IEN
; # =Patient IEN
; -1 =No patient selected
; DGNEWPF New patient added flag
; 1 =New patient added
; Null=Existing patient
N DD,DIC,DINUM,DLAYGO,DO,X,Y
S DIC="^DPT(",DIC(0)="AEMQ"
I $G(DGADDF) S DIC(0)=DIC(0)_"L",DLAYGO=2
W !! D ^DIC S DFN=+Y,DGNEWPF=$P(Y,U,3) N Y W ! D PAUSE^DG10
;If new patient
I DGNEWPF D
. N DA,DIE,DR
. ;Set 'how was patient entered' field
. I $G(DGHOWPT) S DA=DFN,DIE="^DPT(",DR=".098////"_DGHOWPT D ^DIE
. ;Invoke code to execute new patient DR string for patient type
. D NEW^DGRP
Q
;
SETPAR(DGDIV,DGIO,DGASKDEV,DGRPTOUT) ;Set up registration parameters
; Input -- None
; Output -- DGDIV Primary Medical Center Division IEN
; DGIO Registration printer array
; DGASKDEV Registration ask device flag
; DGRPTOUT Quit flag
; 1 =Timeout or User up-arrow
;Check ADT parameter set-up and user
D LO^DGUTL
;Get primary medical center division IEN
S DGDIV=$$PRIM^VASITE
;Get 1010 printer
D GETPRT(DGDIV,.DGIO,.DGASKDEV,.DGRPTOUT)
SETPARQ Q
;
GETPRT(DGDIV,DGIO,DGASKDEV,DGRPTOUT) ;Get registration printer defaults
; Input -- DGDIV Primary Medical Center Division IEN
; Output -- DGIO Registration printer array
; DGASKDEV Registration ask device flag
; DGRPTOUT Quit flag
; -1 =User entered up-arrow
; -2 =Timeout
N DGASK,DTOUT,DUOUT,I,POP,Y
ASK ;Ask device in registration
I $P(^DG(43,1,0),U,39) D G GETPRTQ:$G(DGRPTOUT),ASK:$G(DGASK)
. S DGASK=0
. S:DGDIV %ZIS("B")=$P($G(^DG(40.8,+DGDIV,"DEV")),U,1)
. S %ZIS="NQ",%ZIS("A")="Select 1010 printer: "
. W ! D ^%ZIS I POP S DGRPTOUT=$S($D(DTOUT):-2,1:-1) Q
. I $E(IOST,1,2)'["P-" W !,*7,"Not a printer" S DGASK=1 Q
. S (DGIO(10),DGIO("PRF"),DGIO("RT"),DGIO("HS"))=ION,DGASKDEV=1
;Use closest printer
I '$D(DGIO),$P(^DG(43,1,0),U,30) D
. S %ZIS="N",IOP="HOME"
. D ^%ZIS
. I $D(IOS),IOS,$D(^%ZIS(1,+IOS,99)),$D(^%ZIS(1,+^(99),0)) S Y=$P(^(0),U,1) D
. . W !,"Using closest printer ",Y,!
. . F I=10,"PRF","RT","HS" S DGIO(I)=Y
;Use 10-10 printer for division
I '$D(DGIO),$P($G(^DG(40.8,DGDIV,"DEV")),U,1)'="" S DGIO(10)=$P(^("DEV"),U,1)
;Reset home device
D HOME^%ZIS
GETPRTQ K IO("Q"),%ZIS("B")
Q
;
ELGCHK(DFN) ;Eligibility check for editing
; Input -- DFN Patient IEN
; Output -- 0=No and 1=Yes
N Y
;If the elig is not verified, the user can edit
I $P($G(^DPT(DFN,.361)),U,1)'="V" S Y=1
;If the elig is verified the user must hold the DG ELIGIBILITY key
;to edit
I '$G(Y),$S('($D(DUZ)#2):0,'$D(^XUSEC("DG ELIGIBILITY",DUZ)):0,1:1) S Y=1
Q +$G(Y)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPTU 3172 printed Oct 16, 2024@18:57:03 Page 2
DGRPTU ;ALB/RMO - 10-10T Registration - Utilities; 04/25/2003
+1 ;;5.3;Registration;**108,513**;08/13/93
+2 ;
GETPAT(DGHOWPT,DGADDF,DFN,DGNEWPF) ;Look-up patient
+1 ; Input -- DGHOWPT How was patient entered
+2 ; 1 =10-10T registration
+3 ; DGADDF Add new entry flag (optional)
+4 ; 1 =Allow new patient
+5 ; Output -- DFN Patient IEN
+6 ; # =Patient IEN
+7 ; -1 =No patient selected
+8 ; DGNEWPF New patient added flag
+9 ; 1 =New patient added
+10 ; Null=Existing patient
+11 NEW DD,DIC,DINUM,DLAYGO,DO,X,Y
+12 SET DIC="^DPT("
SET DIC(0)="AEMQ"
+13 IF $GET(DGADDF)
SET DIC(0)=DIC(0)_"L"
SET DLAYGO=2
+14 WRITE !!
DO ^DIC
SET DFN=+Y
SET DGNEWPF=$PIECE(Y,U,3)
NEW Y
WRITE !
DO PAUSE^DG10
+15 ;If new patient
+16 IF DGNEWPF
Begin DoDot:1
+17 NEW DA,DIE,DR
+18 ;Set 'how was patient entered' field
+19 IF $GET(DGHOWPT)
SET DA=DFN
SET DIE="^DPT("
SET DR=".098////"_DGHOWPT
DO ^DIE
+20 ;Invoke code to execute new patient DR string for patient type
+21 DO NEW^DGRP
End DoDot:1
+22 QUIT
+23 ;
SETPAR(DGDIV,DGIO,DGASKDEV,DGRPTOUT) ;Set up registration parameters
+1 ; Input -- None
+2 ; Output -- DGDIV Primary Medical Center Division IEN
+3 ; DGIO Registration printer array
+4 ; DGASKDEV Registration ask device flag
+5 ; DGRPTOUT Quit flag
+6 ; 1 =Timeout or User up-arrow
+7 ;Check ADT parameter set-up and user
+8 DO LO^DGUTL
+9 ;Get primary medical center division IEN
+10 SET DGDIV=$$PRIM^VASITE
+11 ;Get 1010 printer
+12 DO GETPRT(DGDIV,.DGIO,.DGASKDEV,.DGRPTOUT)
SETPARQ QUIT
+1 ;
GETPRT(DGDIV,DGIO,DGASKDEV,DGRPTOUT) ;Get registration printer defaults
+1 ; Input -- DGDIV Primary Medical Center Division IEN
+2 ; Output -- DGIO Registration printer array
+3 ; DGASKDEV Registration ask device flag
+4 ; DGRPTOUT Quit flag
+5 ; -1 =User entered up-arrow
+6 ; -2 =Timeout
+7 NEW DGASK,DTOUT,DUOUT,I,POP,Y
ASK ;Ask device in registration
+1 IF $PIECE(^DG(43,1,0),U,39)
Begin DoDot:1
+2 SET DGASK=0
+3 if DGDIV
SET %ZIS("B")=$PIECE($GET(^DG(40.8,+DGDIV,"DEV")),U,1)
+4 SET %ZIS="NQ"
SET %ZIS("A")="Select 1010 printer: "
+5 WRITE !
DO ^%ZIS
IF POP
SET DGRPTOUT=$SELECT($DATA(DTOUT):-2,1:-1)
QUIT
+6 IF $EXTRACT(IOST,1,2)'["P-"
WRITE !,*7,"Not a printer"
SET DGASK=1
QUIT
+7 SET (DGIO(10),DGIO("PRF"),DGIO("RT"),DGIO("HS"))=ION
SET DGASKDEV=1
End DoDot:1
if $GET(DGRPTOUT)
GOTO GETPRTQ
if $GET(DGASK)
GOTO ASK
+8 ;Use closest printer
+9 IF '$DATA(DGIO)
IF $PIECE(^DG(43,1,0),U,30)
Begin DoDot:1
+10 SET %ZIS="N"
SET IOP="HOME"
+11 DO ^%ZIS
+12 IF $DATA(IOS)
IF IOS
IF $DATA(^%ZIS(1,+IOS,99))
IF $DATA(^%ZIS(1,+^(99),0))
SET Y=$PIECE(^(0),U,1)
Begin DoDot:2
+13 WRITE !,"Using closest printer ",Y,!
+14 FOR I=10,"PRF","RT","HS"
SET DGIO(I)=Y
End DoDot:2
End DoDot:1
+15 ;Use 10-10 printer for division
+16 IF '$DATA(DGIO)
IF $PIECE($GET(^DG(40.8,DGDIV,"DEV")),U,1)'=""
SET DGIO(10)=$PIECE(^("DEV"),U,1)
+17 ;Reset home device
+18 DO HOME^%ZIS
GETPRTQ KILL IO("Q"),%ZIS("B")
+1 QUIT
+2 ;
ELGCHK(DFN) ;Eligibility check for editing
+1 ; Input -- DFN Patient IEN
+2 ; Output -- 0=No and 1=Yes
+3 NEW Y
+4 ;If the elig is not verified, the user can edit
+5 IF $PIECE($GET(^DPT(DFN,.361)),U,1)'="V"
SET Y=1
+6 ;If the elig is verified the user must hold the DG ELIGIBILITY key
+7 ;to edit
+8 IF '$GET(Y)
IF $SELECT('($DATA(DUZ)#2):0,'$DATA(^XUSEC("DG ELIGIBILITY",DUZ)):0,1:1)
SET Y=1
+9 QUIT +$GET(Y)
