- 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