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

DBTSPATU.m

Go to the documentation of this file.
  1. DBTSPATU ;BUILD TXT FILE TO UPDATE PATIENT FILES [ 04/30/1999 5:42 PM ]
  1. PATUP ;
  1. D ^XBKVAR
  1. S CT=0
  1. S LOC=$P(^AUTTLOC(DUZ(2),0),"^",10)
  1. O 51:("/usr/spool/uucppublic/dbtspatup"_LOC_".txt":"W")
  1. S PAT=0
  1. F S PAT=$O(^DBTSPAT(PAT)) Q:+PAT=0 D
  1. .S DBTS("PH")=$P($G(^DPT(PAT,.13)),"^",1)
  1. .D PHONE
  1. .S ID=LOC_"|2|"_PAT
  1. .S OUTREC=ID_$C(9)_DBTS("PH")
  1. .U 51 W OUTREC,!
  1. .S CT=CT+1
  1. .Q
  1. C 51
  1. U 0 W "TOTAL: ",CT
  1. K CT
  1. Q
  1. PHONE ;
  1. Q:DBTS("PH")=""
  1. I DBTS("PH")["(" S DBTS("PH")=$TR(DBTS("PH"),"(","")
  1. I DBTS("PH")[")" S DBTS("PH")=$TR(DBTS("PH"),")","")
  1. I DUZ(2)=2336 S AREA=307
  1. E S AREA=406
  1. I DBTS("PH")?3N1"-"4N S DBTS("PH")=AREA_"-"_DBTS("PH") Q
  1. I DBTS("PH")?7N S DBTS("PH")=AREA_"-"_$E(DBTS("PH"),1,3)_"-"_$E(DBTS("PH"),4,7) Q
  1. I DBTS("PH")?10N S DBTS("PH")=$E(DBTS("PH"),1,3)_"-"_$E(DBTS("PH"),4,6)_"-"_$E(DBTS("PH"),7,10) Q
  1. I DBTS("PH")?6N1"-"4N S DBTS("PH")=$E(DBTS("PH"),1,3)_"-"_$E(DBTS("PH"),4,6)_"-"_$P(DBTS("PH"),"-",2) Q
  1. I DBTS("PH")?3N1"-"3N1"-"4N Q
  1. S DBTS("PH")=""