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

DGRPTL1.m

Go to the documentation of this file.
  1. DGRPTL1 ;ALB/RMO - 10-10T Registration - Build List Area;26 DEC 1996 08:00 am
  1. ;;5.3;Registration;**108**;08/13/93
  1. ;
  1. EN(DGARY,DFN,DGCNT) ;Entry point to build list area
  1. ; Input -- DGARY Global array subscript
  1. ; DFN Patient IEN
  1. ; Output -- DGCNT Number of lines in the list
  1. N DGLINE
  1. S DGLINE=1,DGCNT=0
  1. D DEM(DGARY,DFN,.DGLINE,.DGCNT) ;patient demographics
  1. D EMC(DGARY,DFN,.DGLINE,.DGCNT) ;emergency contact
  1. D EN^DGRPTL2(DGARY,DFN,.DGLINE,.DGCNT) ;military service, elig
  1. D EN^DGRPTL3(DGARY,DFN,.DGLINE,.DGCNT) ;marital, spouse, income, insurance
  1. Q
  1. ;
  1. DEM(DGARY,DFN,DGLINE,DGCNT) ;Patient demographics
  1. ; Input -- DGARY Global array subscript
  1. ; DFN Patient IEN
  1. ; DGLINE Line number
  1. ; Output -- DGCNT Number of lines in the list
  1. N C,DGA,DGA1,DGA2,DGAD,DGELCKF,DGRP,DGSTART,I,X,Y
  1. ;
  1. ;Patient demographics
  1. S DGSTART=DGLINE ;starting line number
  1. D SET(DGARY,DGLINE,"Patient Demographics",31,.DGCNT,IORVON,IORVOFF)
  1. ;
  1. ;Name, ssn, dob
  1. S DGLINE=DGLINE+1
  1. S DGRP(0)=$G(^DPT(DFN,0)) ;patient
  1. S DGELCKF=$$ELGCHK^DGRPTU(DFN) ;elig check for editing
  1. D SET(DGARY,DGLINE,$S(DGELCKF:"",1:"<")_"Name: "_$P(DGRP(0),U),4,.DGCNT)
  1. 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)
  1. D SET(DGARY,DGLINE,"DOB: "_$$FTIME^VALM1($P(DGRP(0),U,3))_$S(DGELCKF:"",1:">"),59,.DGCNT)
  1. ;
  1. ;Sex
  1. S DGLINE=DGLINE+1
  1. S Y=$P(DGRP(0),U,2),C=$P(^DD(2,.02,0),U,2) D Y^DIQ
  1. D SET(DGARY,DGLINE,"Sex: "_$S(Y'="":Y,1:"UNANSWERED"),5,.DGCNT)
  1. ;
  1. ;Marital
  1. S DGLINE=DGLINE+1
  1. S Y=$P(DGRP(0),U,5),C=$P(^DD(2,.05,0),U,2) D Y^DIQ
  1. D SET(DGARY,DGLINE,"Marital: "_$S(Y'="":Y,1:"UNANSWERED"),1,.DGCNT)
  1. ;
  1. ;Address
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"",1,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Permanent Address:",1,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. S DGRP(.11)=$G(^DPT(DFN,.11)) ;address
  1. S DGAD=.11,(DGA1,DGA2)=1 D A^DGRPU
  1. D SET(DGARY,DGLINE,$S($G(DGA(1))'="":DGA(1),1:"NONE ON FILE"),9,.DGCNT)
  1. S I=2 F S I=$O(DGA(I)) Q:I="" D
  1. . S DGLINE=DGLINE+1
  1. . D SET(DGARY,DGLINE,DGA(I),9,.DGCNT)
  1. ;
  1. ;County
  1. S DGLINE=DGLINE+1
  1. ; Get the county name and the VA county code using the
  1. ; County sub-file (#5.01) in the State file (#5)
  1. 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")
  1. D SET(DGARY,DGLINE,"County: "_X,1,.DGCNT)
  1. ;
  1. ;Phone
  1. S DGLINE=DGLINE+1
  1. S DGRP(.13)=$G(^DPT(DFN,.13)) ;phone
  1. D SET(DGARY,DGLINE,"Phone: "_$S($P(DGRP(.13),U,1)'="":$P(DGRP(.13),U,1),1:"UNANSWERED"),2,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Office: "_$S($P(DGRP(.13),U,2)'="":$P(DGRP(.13),U,2),1:"UNANSWERED"),1,.DGCNT)
  1. ;
  1. ;Set line to start on next page
  1. F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET(DGARY,DGLINE,"",1,.DGCNT)
  1. Q
  1. ;
  1. EMC(DGARY,DFN,DGLINE,DGCNT) ;Emergency contact
  1. ; Input -- DGARY Global array subscript
  1. ; DFN Patient IEN
  1. ; DGLINE Line number
  1. ; Output -- DGCNT Number of lines in the list
  1. N DGRP,DGSTART,I
  1. ;
  1. ;Emergency contact
  1. S DGSTART=DGLINE ;starting line number
  1. D SET(DGARY,DGLINE,"Emergency Contact",31,.DGCNT,IORVON,IORVOFF)
  1. ;
  1. ;Next of kin
  1. S DGLINE=DGLINE+1
  1. S DGRP(.21)=$G(^DPT(DFN,.21)) ;next of kin
  1. D SET(DGARY,DGLINE,"NOK: "_$S($P(DGRP(.21),U,1)'="":$P(DGRP(.21),U,1),1:"UNANSWERED"),8,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Relation: "_$S($P(DGRP(.21),U,2)'="":$P(DGRP(.21),U,2),1:"UNANSWERED"),3,.DGCNT)
  1. ;
  1. ;Next of kin address
  1. I $P(DGRP(.21),U,1)'="" D
  1. . N DGA,DGA1,DGA2,DGAD
  1. . S DGAD=.21,DGA1=3,DGA2=1 D A^DGRPU
  1. . S I=0 F S I=$O(DGA(I)) Q:I="" D
  1. . . S DGLINE=DGLINE+1
  1. . . D SET(DGARY,DGLINE,DGA(I),13,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. ;
  1. ;Next of kin phone
  1. D SET(DGARY,DGLINE,"Phone: "_$S($P(DGRP(.21),U,9)'="":$P(DGRP(.21),U,9),1:"UNANSWERED"),6,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Work Phone: "_$S($P(DGRP(.21),U,11)'="":$P(DGRP(.21),U,11),1:"UNANSWERED"),1,.DGCNT)
  1. ;
  1. ;Emergency contact
  1. S DGLINE=DGLINE+1
  1. S DGRP(.33)=$G(^DPT(DFN,.33)) ;emergency contact
  1. D SET(DGARY,DGLINE,"E-Cont.: "_$S($P(DGRP(.33),U,1)'="":$P(DGRP(.33),U,1),1:"UNANSWERED"),4,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Relation: "_$S($P(DGRP(.33),U,2)'="":$P(DGRP(.33),U,2),1:"UNANSWERED"),3,.DGCNT)
  1. ;
  1. ;Emergency contact address
  1. I $P(DGRP(.33),U,1)'="" D
  1. . N DGA,DGA1,DGA2,DGAD
  1. . S DGAD=.33,DGA1=3,DGA2=1 D A^DGRPU
  1. . S I=0 F S I=$O(DGA(I)) Q:I="" D
  1. . . S DGLINE=DGLINE+1
  1. . . D SET(DGARY,DGLINE,DGA(I),13,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. ;
  1. ;Emergency contact phone
  1. D SET(DGARY,DGLINE,"Phone: "_$S($P(DGRP(.33),U,9)'="":$P(DGRP(.33),U,9),1:"UNANSWERED"),6,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Work Phone: "_$S($P(DGRP(.33),U,11)'="":$P(DGRP(.33),U,11),1:"UNANSWERED"),1,.DGCNT)
  1. ;
  1. ;Set line to start on next page
  1. F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET(DGARY,DGLINE,"",1,.DGCNT)
  1. Q
  1. ;
  1. SET(DGARY,DGLINE,DGTEXT,DGCOL,DGCNT,DGON,DGOFF) ; -- set display array
  1. ; Input -- DGARY Global array subscript
  1. ; DGLINE Line number
  1. ; DGTEXT Text
  1. ; DGCOL Column to start at (optional)
  1. ; DGON Highlighting on (optional)
  1. ; DGOFF Highlighting off
  1. ; Output -- DGCNT Number of lines in the list
  1. N X
  1. S:DGLINE>DGCNT DGCNT=DGLINE
  1. S X=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"")
  1. S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,X,DGCOL,$L(DGTEXT))
  1. D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF))
  1. Q