DGRPTL1 ;ALB/RMO - 10-10T Registration - Build List Area;26 DEC 1996 08:00 am
;;5.3;Registration;**108**;08/13/93
;
EN(DGARY,DFN,DGCNT) ;Entry point to build list area
; Input -- DGARY Global array subscript
; DFN Patient IEN
; Output -- DGCNT Number of lines in the list
N DGLINE
S DGLINE=1,DGCNT=0
D DEM(DGARY,DFN,.DGLINE,.DGCNT) ;patient demographics
D EMC(DGARY,DFN,.DGLINE,.DGCNT) ;emergency contact
D EN^DGRPTL2(DGARY,DFN,.DGLINE,.DGCNT) ;military service, elig
D EN^DGRPTL3(DGARY,DFN,.DGLINE,.DGCNT) ;marital, spouse, income, insurance
Q
;
DEM(DGARY,DFN,DGLINE,DGCNT) ;Patient demographics
; Input -- DGARY Global array subscript
; DFN Patient IEN
; DGLINE Line number
; Output -- DGCNT Number of lines in the list
N C,DGA,DGA1,DGA2,DGAD,DGELCKF,DGRP,DGSTART,I,X,Y
;
;Patient demographics
S DGSTART=DGLINE ;starting line number
D SET(DGARY,DGLINE,"Patient Demographics",31,.DGCNT,IORVON,IORVOFF)
;
;Name, ssn, dob
S DGLINE=DGLINE+1
S DGRP(0)=$G(^DPT(DFN,0)) ;patient
S DGELCKF=$$ELGCHK^DGRPTU(DFN) ;elig check for editing
D SET(DGARY,DGLINE,$S(DGELCKF:"",1:"<")_"Name: "_$P(DGRP(0),U),4,.DGCNT)
S X=$P(DGRP(0),U,9) D SET(DGARY,DGLINE,"SS: "_$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),42,.DGCNT)
D SET(DGARY,DGLINE,"DOB: "_$$FTIME^VALM1($P(DGRP(0),U,3))_$S(DGELCKF:"",1:">"),59,.DGCNT)
;
;Sex
S DGLINE=DGLINE+1
S Y=$P(DGRP(0),U,2),C=$P(^DD(2,.02,0),U,2) D Y^DIQ
D SET(DGARY,DGLINE,"Sex: "_$S(Y'="":Y,1:"UNANSWERED"),5,.DGCNT)
;
;Marital
S DGLINE=DGLINE+1
S Y=$P(DGRP(0),U,5),C=$P(^DD(2,.05,0),U,2) D Y^DIQ
D SET(DGARY,DGLINE,"Marital: "_$S(Y'="":Y,1:"UNANSWERED"),1,.DGCNT)
;
;Address
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"",1,.DGCNT)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Permanent Address:",1,.DGCNT)
S DGLINE=DGLINE+1
S DGRP(.11)=$G(^DPT(DFN,.11)) ;address
S DGAD=.11,(DGA1,DGA2)=1 D A^DGRPU
D SET(DGARY,DGLINE,$S($G(DGA(1))'="":DGA(1),1:"NONE ON FILE"),9,.DGCNT)
S I=2 F S I=$O(DGA(I)) Q:I="" D
. S DGLINE=DGLINE+1
. D SET(DGARY,DGLINE,DGA(I),9,.DGCNT)
;
;County
S DGLINE=DGLINE+1
; Get the county name and the VA county code using the
; County sub-file (#5.01) in the State file (#5)
S X=$S($D(^DIC(5,+$P(DGRP(.11),U,5),1,+$P(DGRP(.11),U,7),0)):$E($P(^(0),U,1),1,20)_$S($P(^(0),U,3)'="":" ("_$P(^(0),U,3)_")",1:""),1:"UNANSWERED")
D SET(DGARY,DGLINE,"County: "_X,1,.DGCNT)
;
;Phone
S DGLINE=DGLINE+1
S DGRP(.13)=$G(^DPT(DFN,.13)) ;phone
D SET(DGARY,DGLINE,"Phone: "_$S($P(DGRP(.13),U,1)'="":$P(DGRP(.13),U,1),1:"UNANSWERED"),2,.DGCNT)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Office: "_$S($P(DGRP(.13),U,2)'="":$P(DGRP(.13),U,2),1:"UNANSWERED"),1,.DGCNT)
;
;Set line to start on next page
F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET(DGARY,DGLINE,"",1,.DGCNT)
Q
;
EMC(DGARY,DFN,DGLINE,DGCNT) ;Emergency contact
; Input -- DGARY Global array subscript
; DFN Patient IEN
; DGLINE Line number
; Output -- DGCNT Number of lines in the list
N DGRP,DGSTART,I
;
;Emergency contact
S DGSTART=DGLINE ;starting line number
D SET(DGARY,DGLINE,"Emergency Contact",31,.DGCNT,IORVON,IORVOFF)
;
;Next of kin
S DGLINE=DGLINE+1
S DGRP(.21)=$G(^DPT(DFN,.21)) ;next of kin
D SET(DGARY,DGLINE,"NOK: "_$S($P(DGRP(.21),U,1)'="":$P(DGRP(.21),U,1),1:"UNANSWERED"),8,.DGCNT)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Relation: "_$S($P(DGRP(.21),U,2)'="":$P(DGRP(.21),U,2),1:"UNANSWERED"),3,.DGCNT)
;
;Next of kin address
I $P(DGRP(.21),U,1)'="" D
. N DGA,DGA1,DGA2,DGAD
. S DGAD=.21,DGA1=3,DGA2=1 D A^DGRPU
. S I=0 F S I=$O(DGA(I)) Q:I="" D
. . S DGLINE=DGLINE+1
. . D SET(DGARY,DGLINE,DGA(I),13,.DGCNT)
S DGLINE=DGLINE+1
;
;Next of kin phone
D SET(DGARY,DGLINE,"Phone: "_$S($P(DGRP(.21),U,9)'="":$P(DGRP(.21),U,9),1:"UNANSWERED"),6,.DGCNT)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Work Phone: "_$S($P(DGRP(.21),U,11)'="":$P(DGRP(.21),U,11),1:"UNANSWERED"),1,.DGCNT)
;
;Emergency contact
S DGLINE=DGLINE+1
S DGRP(.33)=$G(^DPT(DFN,.33)) ;emergency contact
D SET(DGARY,DGLINE,"E-Cont.: "_$S($P(DGRP(.33),U,1)'="":$P(DGRP(.33),U,1),1:"UNANSWERED"),4,.DGCNT)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Relation: "_$S($P(DGRP(.33),U,2)'="":$P(DGRP(.33),U,2),1:"UNANSWERED"),3,.DGCNT)
;
;Emergency contact address
I $P(DGRP(.33),U,1)'="" D
. N DGA,DGA1,DGA2,DGAD
. S DGAD=.33,DGA1=3,DGA2=1 D A^DGRPU
. S I=0 F S I=$O(DGA(I)) Q:I="" D
. . S DGLINE=DGLINE+1
. . D SET(DGARY,DGLINE,DGA(I),13,.DGCNT)
S DGLINE=DGLINE+1
;
;Emergency contact phone
D SET(DGARY,DGLINE,"Phone: "_$S($P(DGRP(.33),U,9)'="":$P(DGRP(.33),U,9),1:"UNANSWERED"),6,.DGCNT)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Work Phone: "_$S($P(DGRP(.33),U,11)'="":$P(DGRP(.33),U,11),1:"UNANSWERED"),1,.DGCNT)
;
;Set line to start on next page
F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET(DGARY,DGLINE,"",1,.DGCNT)
Q
;
SET(DGARY,DGLINE,DGTEXT,DGCOL,DGCNT,DGON,DGOFF) ; -- set display array
; Input -- DGARY Global array subscript
; DGLINE Line number
; DGTEXT Text
; DGCOL Column to start at (optional)
; DGON Highlighting on (optional)
; DGOFF Highlighting off
; Output -- DGCNT Number of lines in the list
N X
S:DGLINE>DGCNT DGCNT=DGLINE
S X=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"")
S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,X,DGCOL,$L(DGTEXT))
D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF))
Q
DGRPTL1 ;ALB/RMO - 10-10T Registration - Build List Area;26 DEC 1996 08:00 am
+1 ;;5.3;Registration;**108**;08/13/93
+2 ;
EN(DGARY,DFN,DGCNT) ;Entry point to build list area
+1 ; Input -- DGARY Global array subscript
+2 ; DFN Patient IEN
+3 ; Output -- DGCNT Number of lines in the list
+4 NEW DGLINE
+5 SET DGLINE=1
SET DGCNT=0
+6 ;patient demographics
DO DEM(DGARY,DFN,.DGLINE,.DGCNT)
+7 ;emergency contact
DO EMC(DGARY,DFN,.DGLINE,.DGCNT)
+8 ;military service, elig
DO EN^DGRPTL2(DGARY,DFN,.DGLINE,.DGCNT)
+9 ;marital, spouse, income, insurance
DO EN^DGRPTL3(DGARY,DFN,.DGLINE,.DGCNT)
+10 QUIT
+11 ;
DEM(DGARY,DFN,DGLINE,DGCNT) ;Patient demographics
+1 ; Input -- DGARY Global array subscript
+2 ; DFN Patient IEN
+3 ; DGLINE Line number
+4 ; Output -- DGCNT Number of lines in the list
+5 NEW C,DGA,DGA1,DGA2,DGAD,DGELCKF,DGRP,DGSTART,I,X,Y
+6 ;
+7 ;Patient demographics
+8 ;starting line number
SET DGSTART=DGLINE
+9 DO SET(DGARY,DGLINE,"Patient Demographics",31,.DGCNT,IORVON,IORVOFF)
+10 ;
+11 ;Name, ssn, dob
+12 SET DGLINE=DGLINE+1
+13 ;patient
SET DGRP(0)=$GET(^DPT(DFN,0))
+14 ;elig check for editing
SET DGELCKF=$$ELGCHK^DGRPTU(DFN)
+15 DO SET(DGARY,DGLINE,$SELECT(DGELCKF:"",1:"<")_"Name: "_$PIECE(DGRP(0),U),4,.DGCNT)
+16 SET X=$PIECE(DGRP(0),U,9)
DO SET(DGARY,DGLINE,"SS: "_$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10),42,.DGCNT)
+17 DO SET(DGARY,DGLINE,"DOB: "_$$FTIME^VALM1($PIECE(DGRP(0),U,3))_$SELECT(DGELCKF:"",1:">"),59,.DGCNT)
+18 ;
+19 ;Sex
+20 SET DGLINE=DGLINE+1
+21 SET Y=$PIECE(DGRP(0),U,2)
SET C=$PIECE(^DD(2,.02,0),U,2)
DO Y^DIQ
+22 DO SET(DGARY,DGLINE,"Sex: "_$SELECT(Y'="":Y,1:"UNANSWERED"),5,.DGCNT)
+23 ;
+24 ;Marital
+25 SET DGLINE=DGLINE+1
+26 SET Y=$PIECE(DGRP(0),U,5)
SET C=$PIECE(^DD(2,.05,0),U,2)
DO Y^DIQ
+27 DO SET(DGARY,DGLINE,"Marital: "_$SELECT(Y'="":Y,1:"UNANSWERED"),1,.DGCNT)
+28 ;
+29 ;Address
+30 SET DGLINE=DGLINE+1
+31 DO SET(DGARY,DGLINE,"",1,.DGCNT)
+32 SET DGLINE=DGLINE+1
+33 DO SET(DGARY,DGLINE,"Permanent Address:",1,.DGCNT)
+34 SET DGLINE=DGLINE+1
+35 ;address
SET DGRP(.11)=$GET(^DPT(DFN,.11))
+36 SET DGAD=.11
SET (DGA1,DGA2)=1
DO A^DGRPU
+37 DO SET(DGARY,DGLINE,$SELECT($GET(DGA(1))'="":DGA(1),1:"NONE ON FILE"),9,.DGCNT)
+38 SET I=2
FOR
SET I=$ORDER(DGA(I))
IF I=""
QUIT
Begin DoDot:1
+39 SET DGLINE=DGLINE+1
+40 DO SET(DGARY,DGLINE,DGA(I),9,.DGCNT)
End DoDot:1
+41 ;
+42 ;County
+43 SET DGLINE=DGLINE+1
+44 ; Get the county name and the VA county code using the
+45 ; County sub-file (#5.01) in the State file (#5)
+46 SET X=$SELECT($DATA(^DIC(5,+$PIECE(DGRP(.11),U,5),1,+$PIECE(DGRP(.11),U,7),0)):$EXTRACT($PIECE(^(0),U,1),1,20)_$SELECT($PIECE(^(0),U,3)'="":" ("_$PIECE(^(0),U,3)_")",1:""),1:"UNANSWERED")
+47 DO SET(DGARY,DGLINE,"County: "_X,1,.DGCNT)
+48 ;
+49 ;Phone
+50 SET DGLINE=DGLINE+1
+51 ;phone
SET DGRP(.13)=$GET(^DPT(DFN,.13))
+52 DO SET(DGARY,DGLINE,"Phone: "_$SELECT($PIECE(DGRP(.13),U,1)'="":$PIECE(DGRP(.13),U,1),1:"UNANSWERED"),2,.DGCNT)
+53 SET DGLINE=DGLINE+1
+54 DO SET(DGARY,DGLINE,"Office: "_$SELECT($PIECE(DGRP(.13),U,2)'="":$PIECE(DGRP(.13),U,2),1:"UNANSWERED"),1,.DGCNT)
+55 ;
+56 ;Set line to start on next page
+57 FOR DGLINE=DGLINE+1:1:DGSTART+VALM("LINES")
DO SET(DGARY,DGLINE,"",1,.DGCNT)
+58 QUIT
+59 ;
EMC(DGARY,DFN,DGLINE,DGCNT) ;Emergency contact
+1 ; Input -- DGARY Global array subscript
+2 ; DFN Patient IEN
+3 ; DGLINE Line number
+4 ; Output -- DGCNT Number of lines in the list
+5 NEW DGRP,DGSTART,I
+6 ;
+7 ;Emergency contact
+8 ;starting line number
SET DGSTART=DGLINE
+9 DO SET(DGARY,DGLINE,"Emergency Contact",31,.DGCNT,IORVON,IORVOFF)
+10 ;
+11 ;Next of kin
+12 SET DGLINE=DGLINE+1
+13 ;next of kin
SET DGRP(.21)=$GET(^DPT(DFN,.21))
+14 DO SET(DGARY,DGLINE,"NOK: "_$SELECT($PIECE(DGRP(.21),U,1)'="":$PIECE(DGRP(.21),U,1),1:"UNANSWERED"),8,.DGCNT)
+15 SET DGLINE=DGLINE+1
+16 DO SET(DGARY,DGLINE,"Relation: "_$SELECT($PIECE(DGRP(.21),U,2)'="":$PIECE(DGRP(.21),U,2),1:"UNANSWERED"),3,.DGCNT)
+17 ;
+18 ;Next of kin address
+19 IF $PIECE(DGRP(.21),U,1)'=""
Begin DoDot:1
+20 NEW DGA,DGA1,DGA2,DGAD
+21 SET DGAD=.21
SET DGA1=3
SET DGA2=1
DO A^DGRPU
+22 SET I=0
FOR
SET I=$ORDER(DGA(I))
IF I=""
QUIT
Begin DoDot:2
+23 SET DGLINE=DGLINE+1
+24 DO SET(DGARY,DGLINE,DGA(I),13,.DGCNT)
End DoDot:2
End DoDot:1
+25 SET DGLINE=DGLINE+1
+26 ;
+27 ;Next of kin phone
+28 DO SET(DGARY,DGLINE,"Phone: "_$SELECT($PIECE(DGRP(.21),U,9)'="":$PIECE(DGRP(.21),U,9),1:"UNANSWERED"),6,.DGCNT)
+29 SET DGLINE=DGLINE+1
+30 DO SET(DGARY,DGLINE,"Work Phone: "_$SELECT($PIECE(DGRP(.21),U,11)'="":$PIECE(DGRP(.21),U,11),1:"UNANSWERED"),1,.DGCNT)
+31 ;
+32 ;Emergency contact
+33 SET DGLINE=DGLINE+1
+34 ;emergency contact
SET DGRP(.33)=$GET(^DPT(DFN,.33))
+35 DO SET(DGARY,DGLINE,"E-Cont.: "_$SELECT($PIECE(DGRP(.33),U,1)'="":$PIECE(DGRP(.33),U,1),1:"UNANSWERED"),4,.DGCNT)
+36 SET DGLINE=DGLINE+1
+37 DO SET(DGARY,DGLINE,"Relation: "_$SELECT($PIECE(DGRP(.33),U,2)'="":$PIECE(DGRP(.33),U,2),1:"UNANSWERED"),3,.DGCNT)
+38 ;
+39 ;Emergency contact address
+40 IF $PIECE(DGRP(.33),U,1)'=""
Begin DoDot:1
+41 NEW DGA,DGA1,DGA2,DGAD
+42 SET DGAD=.33
SET DGA1=3
SET DGA2=1
DO A^DGRPU
+43 SET I=0
FOR
SET I=$ORDER(DGA(I))
IF I=""
QUIT
Begin DoDot:2
+44 SET DGLINE=DGLINE+1
+45 DO SET(DGARY,DGLINE,DGA(I),13,.DGCNT)
End DoDot:2
End DoDot:1
+46 SET DGLINE=DGLINE+1
+47 ;
+48 ;Emergency contact phone
+49 DO SET(DGARY,DGLINE,"Phone: "_$SELECT($PIECE(DGRP(.33),U,9)'="":$PIECE(DGRP(.33),U,9),1:"UNANSWERED"),6,.DGCNT)
+50 SET DGLINE=DGLINE+1
+51 DO SET(DGARY,DGLINE,"Work Phone: "_$SELECT($PIECE(DGRP(.33),U,11)'="":$PIECE(DGRP(.33),U,11),1:"UNANSWERED"),1,.DGCNT)
+52 ;
+53 ;Set line to start on next page
+54 FOR DGLINE=DGLINE+1:1:DGSTART+VALM("LINES")
DO SET(DGARY,DGLINE,"",1,.DGCNT)
+55 QUIT
+56 ;
SET(DGARY,DGLINE,DGTEXT,DGCOL,DGCNT,DGON,DGOFF) ; -- set display array
+1 ; Input -- DGARY Global array subscript
+2 ; DGLINE Line number
+3 ; DGTEXT Text
+4 ; DGCOL Column to start at (optional)
+5 ; DGON Highlighting on (optional)
+6 ; DGOFF Highlighting off
+7 ; Output -- DGCNT Number of lines in the list
+8 NEW X
+9 IF DGLINE>DGCNT
SET DGCNT=DGLINE
+10 SET X=$SELECT($DATA(^TMP(DGARY,$JOB,DGLINE,0)):^(0),1:"")
+11 SET ^TMP(DGARY,$JOB,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,X,DGCOL,$LENGTH(DGTEXT))
+12 IF $GET(DGON)]""!($GET(DGOFF)]"")
DO CNTRL^VALM10(DGLINE,DGCOL,$LENGTH(DGTEXT),$GET(DGON),$GET(DGOFF))
+13 QUIT
