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

DG53334A.m

Go to the documentation of this file. 
  1. DG53334A ;ALB/MRY - ALS EXTRACT; ; 11/16/00 1:15pm
  1.  ;;5.3;Registration;**334,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;Description:
  1.  ;Patient data will be extracted from the Patient file (#2) for all 
  1.  ;hospital sites.  Station numbers and SSN's have been provided and 
  1.  ;stored in file^XTMP.
  1.  ;
  1.  ;
  1. EN ; -- Entry point for manually running extract.
  1.  D EN^DG53334D
  1.  Q
  1.  ;
  1.  ;
  1. START ; -- Called from POSTINST^DG53334C and EN^DG53334D
  1.  I $D(DUZ)'=11 D  Q
  1.  . D BMES^XPDUTL("     Please set DUZ variables.")
  1.  . S DGARY(1)=("     To set up the DUZ variables, type the command D ^XUP.")
  1.  . S DGARY(2)=("     At prompt Select OPTION NAME: press the return key.")
  1.  . S DGARY(3)=("     To restart the ALS Extract type D EN^DG53334A.")
  1.  . D MES^XPDUTL(.DGARY)
  1.  ;
  1.  D BMES^XPDUTL()
  1.  S DGARY(1)=("                 >>> ALS Extract <<< ")
  1.  S DGARY(2)=("   This extract will generate 2 mail messages to you.")
  1.  S DGARY(3)=("   One of the messsages will contain the data extracted")
  1.  S DGARY(4)=("   and the second message will contain any errors that")
  1.  S DGARY(5)=("   may have occurred during the ALS extract.")
  1.  D MES^XPDUTL(.DGARY)
  1.  ;
  1.  N DGARY
  1.  S DGTATION=+$P($$SITE^VASITE(),U,3)
  1.  S DGSTART=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  I '$D(^XTMP("DGALS","S",DGTATION))!$D(^XTMP("DGALS","S",DGTATION,"ERROR","NO DATA REQUESTED")) D  Q
  1.  . D BMES^XPDUTL("  ")
  1.  . S DGARY(1)=("  Data was not requested from this site.")
  1.  . S DGARY(2)=("  No mail messages will be generated.")
  1.  . S DGARY(3)=("  No error has occurred.")
  1.  . D MES^XPDUTL(.DGARY)
  1.  . D BMES^XPDUTL(">>>...all done.")
  1.  . D FMAIL^DG53334B(0)
  1.  ;
  1.  ;
  1.  K ^XTMP("DGALS",$J,"DATA")
  1.  K ^XTMP("DGALS",$J,"ERROR")
  1.  K ^XTMP("DGALS","S",DGTATION,"DFN")
  1.  ;
  1.  I '$D(ZTQUEUED) D
  1.  .D BMES^XPDUTL(">>> Looking up patients DFNs from SSNs <<<")
  1.  D GETDFN(DGTATION)
  1.  ;
  1.  I '$D(ZTQUEUED) D
  1.  .D BMES^XPDUTL(">>> Looking up patients data from DFNs <<<")
  1.  D DIQLOOK(DGTATION)
  1.  ;
  1.  I '$D(ZTQUEUED) D
  1.  .D BMES^XPDUTL(">>> Creating Mail message of patients data <<<")
  1.  D SENDATA(DGTATION)
  1.  ;
  1.  ;mail summary
  1.  D FMAIL^DG53334B(1)
  1.  ;
  1.  I '$D(ZTQUEUED) D
  1.  .D BMES^XPDUTL(">>> ....ALS Extract has completed")
  1.  ;
  1.  ;
  1.  K DGFIELD,DGN,DGP,DGPECE,DGSTART
  1.  K DGZ,DGFLDS,DGDFN,DGTATION,DGSSN,DGLINE
  1.  Q
  1. GETDFN(DGTATION) ;
  1.  ;From array of SSNs get DFN's from DPT
  1.  ; go down station array
  1.  S DGSSN=0
  1.  F  S DGSSN=$O(^XTMP("DGALS","S",DGTATION,DGSSN)) Q:'DGSSN  DO
  1.  . S DGDFN=$$DFN(DGSSN)
  1.  . I DGDFN S ^XTMP("DGALS","S",DGTATION,"DFN",DGDFN)=DGSSN
  1.  . E  S ^XTMP("DGALS",$J,"ERROR","SSN",DGSSN)=DGDFN
  1.  .;
  1.  . I (($P($H,",",2))#20) Q
  1.  . I '$D(ZTQUEUED) W "."
  1.  Q
  1. DIQLOOK(DGTATION) ;
  1.  ;
  1.  ; get array of fields to lookup
  1.  D INIFLDS
  1.  ; for each dfn call gets^diq
  1.  S DGDFN=0
  1.  F  S DGDFN=$O(^XTMP("DGALS","S",DGTATION,"DFN",DGDFN)) Q:'DGDFN  DO
  1.  . D GETDGIQ(DGDFN)
  1.  .;
  1.  . I (($P($H,",",2))#3) Q
  1.  . I '$D(ZTQUEUED) W "."
  1.  .;
  1.  Q
  1. GETDGIQ(DGDFN) ;
  1.  K DGDATA,DGERR
  1.  ;
  1.  F DGFLDS=1:1:2 D
  1.  . D GETS^DIQ(2,DGDFN,DGFLDS(DGFLDS),"E","DGDATA","DGERR")
  1.  .;
  1.  .; merge will set ,2,dfn_",",field,"E")=external value
  1.  .;
  1.  . M ^XTMP("DGALS",$J,"DATA")=DGDATA
  1.  . K DGDATA
  1.  . I $D(DGERR) D  K DGERR
  1.  . .;if a field has err whatodo
  1.  . .;
  1.  . .; check to see if each field was set in returned array 
  1.  . . F DGP=1:1 S DGFIELD=$P(DGFLDS(DGFLDS),";",DGP) Q:'DGFIELD  D
  1.  . . .;
  1.  . . .;  indicates fileman returned error
  1.  . . . I '$D(^XTMP("DGALS",$J,"DATA",2,DGDFN_",",DGFIELD,"E")) D
  1.  . . . .;
  1.  . . . .; set it to null to keep the piece position in mail
  1.  . . . . S ^XTMP("DGALS",$J,"DATA",2,DGDFN_",",DGFIELD,"E")=""
  1.  . . . .;
  1.  . . . .;the dgerr array is set by fm in order of missing fields
  1.  . . . . S DGERR=$O(DGERR("DIERR",0)) I 'DGERR K DGERR Q
  1.  . . . . M ^XTMP("DGALS",$J,"ERROR",DGDFN,DGFIELD)=DGERR("DIERR",DGERR)
  1.  . . . . S ^XTMP("DGALS",$J,"ERROR",DGDFN,"SSN")=$P($G(^DPT(DGDFN,0)),"^",9)
  1.  . . . .;pop the array
  1.  . . . . K DGERR("DIERR",DGERR)
  1.  . . .;
  1.  ;
  1.  Q
  1. DFN(SSN) ;function to lookup DFN from SSN x-ref
  1.  ; input SSN
  1.  ; output DFN or error code
  1.  N DFN
  1.  ; make sure dfn is numeric and not null
  1.  I $O(^DPT("SSN",SSN,0))
  1.  E  Q "No SSN Index for "_SSN
  1.  ;
  1.  I $O(^DPT("SSN",SSN,0))=$O(^DPT("SSN",SSN,""),-1)
  1.  E  Q "Duplicate SSN in cross-ref "_SSN
  1.  ;
  1.  S DFN=$O(^DPT("SSN",SSN,0))
  1.  ;
  1.  I $G(^DPT(DFN,0))]""
  1.  E  Q "No Zero node in DPT for SSN "_SSN
  1.  ;
  1.  I $P($G(^DPT(DFN,0)),"^",9)=SSN
  1.  E  Q "Bad SSN cross-ref "_SSN
  1.  Q DFN
  1.  ;
  1. INIFLDS ; set up array of fields to be used in fm getsdiq call
  1.  S DGFLDS(1)=$P($T(FLDS1),";;",2)
  1.  S DGFLDS(2)=$P($T(FLDS2),";;",2)
  1.  Q
  1.  ;Retrieve:
  1.  ;         Name, Provider,Street Address [Line 1], Zip+4,
  1.  ;         Street Address [Line 2]
  1.  ;         Street Address [Line 3],City, State, Zip Code County,
  1.  ;         Temporary Address Active?,Temporary Street [Line 1],
  1.  ;         Temporary Address County, Temporary Zip+4,
  1.  ;         Temporary Street [Line 2], Temporary Street Address [Line 3], Temporary
  1.  ;         City, Temporary State, Temporary Zip Code, Temporary Address Start Date,
  1.  ;         Temporary Address End Date, Phone Number [Residence], Phone Number [Work]
  1. FLDS1 ;;.01;.104;.111;.1112;.112;.113;.114;.115;.116;.117;.12105;.1211;.12111;.12112;.1212;.1213
  1. FLDS2 ;;.1214;.1215;.1216;.1217;.1218;.1219;.131;.132;
  1.  Q
  1. SENDATA(DGTATION) ;
  1.  ; dgline is the message line
  1.  S DGLINE=0
  1.  S DGDFN=""
  1.  ; (2,dfn, field  set up from fileman data merge, dfn is dfn_"," 
  1.  F  S DGDFN=$O(^XTMP("DGALS",$J,"DATA",2,DGDFN)) Q:'DGDFN  DO 
  1.  . D SETMAIL^DG53334B(DGTATION,DGDFN)
  1.  .;
  1.  . I (($P($H,",",2))#10) Q
  1.  . I '$D(ZTQUEUED) W " ."
  1.  .;
  1.  ;final mailman set
  1.  Q:'DGLINE
  1.  D SMAIL^DG53334B(DGLINE)
  1.  ;
  1.  Q