DG53293A ;AR/BP - ALS EXTRACT; ; 7/26/00 1:15pm
;;5.3;Registration;**293,1015**;Aug 13, 1993;Build 21
;
;Description:
;Patient data will be extracted from the Patient file (#2) for all
;hospital sites. Station numbers and SSN's have been provided and
;stored in file^XTMP.
;
;
EN ; -- Entry point for manually running extract.
D EN^DG53293D
Q
;
;
START ; -- Called from POSTINST^DG53293C and EN^DG53293D
I $D(DUZ)'=11 D Q
. D BMES^XPDUTL(" Please set DUZ variables.")
. S DGARY(1)=(" To set up the DUZ variables, type the command D ^XUP.")
. S DGARY(2)=(" At prompt Select OPTION NAME: press the return key.")
. S DGARY(3)=(" To restart the ALS Extract type D EN^DG53293A.")
. D MES^XPDUTL(.DGARY)
;
D BMES^XPDUTL()
S DGARY(1)=(" >>> ALS Extract <<< ")
S DGARY(2)=(" This extract will generate 2 mail messages to you.")
S DGARY(3)=(" One of the messsages will contain the data extracted")
S DGARY(4)=(" and the second message will contain any errors that")
S DGARY(5)=(" may have occurred during the ALS extract.")
D MES^XPDUTL(.DGARY)
;
N DGARY
S DGTATION=+$P($$SITE^VASITE(),U,3)
S DGSTART=$$FMTE^XLFDT($$NOW^XLFDT)
I '$D(^XTMP("DGALS","S",DGTATION))!$D(^XTMP("DGALS","S",DGTATION,"ERROR","NO DATA REQUESTED")) D Q
. D BMES^XPDUTL(" ")
. S DGARY(1)=(" Data was not requested from this site.")
. S DGARY(2)=(" No mail messages will be generated.")
. S DGARY(3)=(" No error has occurred.")
. D MES^XPDUTL(.DGARY)
. D BMES^XPDUTL(">>>...all done.")
. D FMAIL^DG53293B(0)
;
;
K ^XTMP("DGALS",$J,"DATA")
K ^XTMP("DGALS",$J,"ERROR")
K ^XTMP("DGALS","S",DGTATION,"DFN")
;
I '$D(ZTQUEUED) D
.D BMES^XPDUTL(">>> Looking up patients DFNs from SSNs <<<")
D GETDFN(DGTATION)
;
I '$D(ZTQUEUED) D
.D BMES^XPDUTL(">>> Looking up patients data from DFNs <<<")
D DIQLOOK(DGTATION)
;
I '$D(ZTQUEUED) D
.D BMES^XPDUTL(">>> Creating Mail message of patients data <<<")
D SENDATA(DGTATION)
;
;mail summary
D FMAIL^DG53293B(1)
;
I '$D(ZTQUEUED) D
.D BMES^XPDUTL(">>> ....ALS Extract has completed")
;
;
K DGFIELD,DGN,DGP,DGPECE,DGSTART
K DGZ,DGFLDS,DGDFN,DGTATION,DGSSN,DGLINE
Q
GETDFN(DGTATION) ;
;From strings of SSNs get DFN's from DPT
; go down station array
S DGN=0
F S DGN=$O(^XTMP("DGALS","S",DGTATION,DGN)) Q:'DGN DO
.;;piece out ssn
.F DGP=1:1 S DGSSN=$P(^XTMP("DGALS","S",DGTATION,DGN),"^",DGP) Q:'DGSSN DO
. . S DGDFN=$$DFN(DGSSN)
. . I DGDFN S ^XTMP("DGALS","S",DGTATION,"DFN",DGDFN)=DGSSN
. . E S ^XTMP("DGALS",$J,"ERROR","SSN",DGSSN)=DGDFN
. .;
. . I (($P($H,",",2))#20) Q
. . I '$D(ZTQUEUED) W "."
Q
DIQLOOK(DGTATION) ;
;
; get array of fields to lookup
D INIFLDS
; for each dfn call gets^diq
S DGDFN=0
F S DGDFN=$O(^XTMP("DGALS","S",DGTATION,"DFN",DGDFN)) Q:'DGDFN DO
. D GETDGIQ(DGDFN)
.;
. I (($P($H,",",2))#3) Q
. I '$D(ZTQUEUED) W "."
.;
Q
GETDGIQ(DGDFN) ;
K DGDATA,DGERR
;
F DGFLDS=1:1:2 D
. D GETS^DIQ(2,DGDFN,DGFLDS(DGFLDS),"E","DGDATA","DGERR")
.;
.; merge will set ,2,dfn_",",field,"E")=external value
.;
. M ^XTMP("DGALS",$J,"DATA")=DGDATA
. K DGDATA
. I $D(DGERR) D K DGERR
. .;if a field has err whatodo
. .;
. .; check to see if each field was set in returned array
. . F DGP=1:1 S DGFIELD=$P(DGFLDS(DGFLDS),";",DGP) Q:'DGFIELD D
. . .;
. . .; indicates fileman returned error
. . . I '$D(^XTMP("DGALS",$J,"DATA",2,DGDFN_",",DGFIELD,"E")) D
. . . .;
. . . .; set it to null to keep the piece position in mail
. . . . S ^XTMP("DGALS",$J,"DATA",2,DGDFN_",",DGFIELD,"E")=""
. . . .;
. . . .;the dgerr array is set by fm in order of missing fields
. . . . S DGERR=$O(DGERR("DIERR",0)) I 'DGERR K DGERR Q
. . . . M ^XTMP("DGALS",$J,"ERROR",DGDFN,DGFIELD)=DGERR("DIERR",DGERR)
. . . . S ^XTMP("DGALS",$J,"ERROR",DGDFN,"SSN")=$P($G(^DPT(DGDFN,0)),"^",9)
. . . .;pop the array
. . . . K DGERR("DIERR",DGERR)
. . .;
;
Q
DFN(SSN) ;function to lookup DFN from SSN x-ref
; input SSN
; output DFN or error code
N DFN
; make sure dfn is numeric and not null
I $O(^DPT("SSN",SSN,0))
E Q "No SSN Index for "_SSN
;
I $O(^DPT("SSN",SSN,0))=$O(^DPT("SSN",SSN,""),-1)
E Q "Duplicate SSN in cross-ref "_SSN
;
S DFN=$O(^DPT("SSN",SSN,0))
;
I $G(^DPT(DFN,0))]""
E Q "No Zero node in DPT for SSN "_SSN
;
I $P($G(^DPT(DFN,0)),"^",9)=SSN
E Q "Bad SSN cross-ref "_SSN
Q DFN
;
INIFLDS ; set up array of fields to be used in fm getsdiq call
S DGFLDS(1)=$P($T(FLDS1),";;",2)
S DGFLDS(2)=$P($T(FLDS2),";;",2)
Q
;Retrieve:
; Name, Provider,Street Address [Line 1], Zip+4,
; Street Address [Line 2]
; Street Address [Line 3],City, State, Zip Code County,
; Temporary Address Active?,Temporary Street [Line 1],
; Temporary Address County, Temporary Zip+4,
; Temporary Street [Line 2], Temporary Street Address [Line 3], Temporary
; City, Temporary State, Temporary Zip Code, Temporary Address Start Date,
; Temporary Address End Date, Phone Number [Residence], Phone Number [Work]
FLDS1 ;;.01;.104;.111;.1112;.112;.113;.114;.115;.116;.117;.12105;.1211;.12111;.12112;.1212;.1213
FLDS2 ;;.1214;.1215;.1216;.1217;.1218;.1219;.131;.132;
Q
SENDATA(DGTATION) ;
; dgline is the message line
S DGLINE=0
S DGDFN=""
; (2,dfn, field set up from fileman data merge, dfn is dfn_","
F S DGDFN=$O(^XTMP("DGALS",$J,"DATA",2,DGDFN)) Q:'DGDFN DO
. D SETMAIL^DG53293B(DGTATION,DGDFN)
.;
. I (($P($H,",",2))#10) Q
. I '$D(ZTQUEUED) W " ."
.;
;final mailman set
Q:'DGLINE
D SMAIL^DG53293B(DGLINE)
;
Q
DG53293A ;AR/BP - ALS EXTRACT; ; 7/26/00 1:15pm
+1 ;;5.3;Registration;**293,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;Description:
+4 ;Patient data will be extracted from the Patient file (#2) for all
+5 ;hospital sites. Station numbers and SSN's have been provided and
+6 ;stored in file^XTMP.
+7 ;
+8 ;
EN ; -- Entry point for manually running extract.
+1 DO EN^DG53293D
+2 QUIT
+3 ;
+4 ;
START ; -- Called from POSTINST^DG53293C and EN^DG53293D
+1 IF $DATA(DUZ)'=11
Begin DoDot:1
+2 DO BMES^XPDUTL(" Please set DUZ variables.")
+3 SET DGARY(1)=(" To set up the DUZ variables, type the command D ^XUP.")
+4 SET DGARY(2)=(" At prompt Select OPTION NAME: press the return key.")
+5 SET DGARY(3)=(" To restart the ALS Extract type D EN^DG53293A.")
+6 DO MES^XPDUTL(.DGARY)
End DoDot:1
QUIT
+7 ;
+8 DO BMES^XPDUTL()
+9 SET DGARY(1)=(" >>> ALS Extract <<< ")
+10 SET DGARY(2)=(" This extract will generate 2 mail messages to you.")
+11 SET DGARY(3)=(" One of the messsages will contain the data extracted")
+12 SET DGARY(4)=(" and the second message will contain any errors that")
+13 SET DGARY(5)=(" may have occurred during the ALS extract.")
+14 DO MES^XPDUTL(.DGARY)
+15 ;
+16 NEW DGARY
+17 SET DGTATION=+$PIECE($$SITE^VASITE(),U,3)
+18 SET DGSTART=$$FMTE^XLFDT($$NOW^XLFDT)
+19 IF '$DATA(^XTMP("DGALS","S",DGTATION))!$DATA(^XTMP("DGALS","S",DGTATION,"ERROR","NO DATA REQUESTED"))
Begin DoDot:1
+20 DO BMES^XPDUTL(" ")
+21 SET DGARY(1)=(" Data was not requested from this site.")
+22 SET DGARY(2)=(" No mail messages will be generated.")
+23 SET DGARY(3)=(" No error has occurred.")
+24 DO MES^XPDUTL(.DGARY)
+25 DO BMES^XPDUTL(">>>...all done.")
+26 DO FMAIL^DG53293B(0)
End DoDot:1
QUIT
+27 ;
+28 ;
+29 KILL ^XTMP("DGALS",$JOB,"DATA")
+30 KILL ^XTMP("DGALS",$JOB,"ERROR")
+31 KILL ^XTMP("DGALS","S",DGTATION,"DFN")
+32 ;
+33 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+34 DO BMES^XPDUTL(">>> Looking up patients DFNs from SSNs <<<")
End DoDot:1
+35 DO GETDFN(DGTATION)
+36 ;
+37 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+38 DO BMES^XPDUTL(">>> Looking up patients data from DFNs <<<")
End DoDot:1
+39 DO DIQLOOK(DGTATION)
+40 ;
+41 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+42 DO BMES^XPDUTL(">>> Creating Mail message of patients data <<<")
End DoDot:1
+43 DO SENDATA(DGTATION)
+44 ;
+45 ;mail summary
+46 DO FMAIL^DG53293B(1)
+47 ;
+48 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+49 DO BMES^XPDUTL(">>> ....ALS Extract has completed")
End DoDot:1
+50 ;
+51 ;
+52 KILL DGFIELD,DGN,DGP,DGPECE,DGSTART
+53 KILL DGZ,DGFLDS,DGDFN,DGTATION,DGSSN,DGLINE
+54 QUIT
GETDFN(DGTATION) ;
+1 ;From strings of SSNs get DFN's from DPT
+2 ; go down station array
+3 SET DGN=0
+4 FOR
SET DGN=$ORDER(^XTMP("DGALS","S",DGTATION,DGN))
IF 'DGN
QUIT
Begin DoDot:1
+5 ;;piece out ssn
+6 FOR DGP=1:1
SET DGSSN=$PIECE(^XTMP("DGALS","S",DGTATION,DGN),"^",DGP)
IF 'DGSSN
QUIT
Begin DoDot:2
+7 SET DGDFN=$$DFN(DGSSN)
+8 IF DGDFN
SET ^XTMP("DGALS","S",DGTATION,"DFN",DGDFN)=DGSSN
+9 IF '$TEST
SET ^XTMP("DGALS",$JOB,"ERROR","SSN",DGSSN)=DGDFN
+10 ;
+11 IF (($PIECE($HOROLOG,",",2))#20)
QUIT
+12 IF '$DATA(ZTQUEUED)
WRITE "."
End DoDot:2
End DoDot:1
+13 QUIT
DIQLOOK(DGTATION) ;
+1 ;
+2 ; get array of fields to lookup
+3 DO INIFLDS
+4 ; for each dfn call gets^diq
+5 SET DGDFN=0
+6 FOR
SET DGDFN=$ORDER(^XTMP("DGALS","S",DGTATION,"DFN",DGDFN))
IF 'DGDFN
QUIT
Begin DoDot:1
+7 DO GETDGIQ(DGDFN)
+8 ;
+9 IF (($PIECE($HOROLOG,",",2))#3)
QUIT
+10 IF '$DATA(ZTQUEUED)
WRITE "."
+11 ;
End DoDot:1
+12 QUIT
GETDGIQ(DGDFN) ;
+1 KILL DGDATA,DGERR
+2 ;
+3 FOR DGFLDS=1:1:2
Begin DoDot:1
+4 DO GETS^DIQ(2,DGDFN,DGFLDS(DGFLDS),"E","DGDATA","DGERR")
+5 ;
+6 ; merge will set ,2,dfn_",",field,"E")=external value
+7 ;
+8 MERGE ^XTMP("DGALS",$JOB,"DATA")=DGDATA
+9 KILL DGDATA
+10 IF $DATA(DGERR)
Begin DoDot:2
+11 ;if a field has err whatodo
+12 ;
+13 ; check to see if each field was set in returned array
+14 FOR DGP=1:1
SET DGFIELD=$PIECE(DGFLDS(DGFLDS),";",DGP)
IF 'DGFIELD
QUIT
Begin DoDot:3
+15 ;
+16 ; indicates fileman returned error
+17 IF '$DATA(^XTMP("DGALS",$JOB,"DATA",2,DGDFN_",",DGFIELD,"E"))
Begin DoDot:4
+18 ;
+19 ; set it to null to keep the piece position in mail
+20 SET ^XTMP("DGALS",$JOB,"DATA",2,DGDFN_",",DGFIELD,"E")=""
+21 ;
+22 ;the dgerr array is set by fm in order of missing fields
+23 SET DGERR=$ORDER(DGERR("DIERR",0))
IF 'DGERR
KILL DGERR
QUIT
+24 MERGE ^XTMP("DGALS",$JOB,"ERROR",DGDFN,DGFIELD)=DGERR("DIERR",DGERR)
+25 SET ^XTMP("DGALS",$JOB,"ERROR",DGDFN,"SSN")=$PIECE($GET(^DPT(DGDFN,0)),"^",9)
+26 ;pop the array
+27 KILL DGERR("DIERR",DGERR)
End DoDot:4
+28 ;
End DoDot:3
End DoDot:2
KILL DGERR
End DoDot:1
+29 ;
+30 QUIT
DFN(SSN) ;function to lookup DFN from SSN x-ref
+1 ; input SSN
+2 ; output DFN or error code
+3 NEW DFN
+4 ; make sure dfn is numeric and not null
+5 IF $ORDER(^DPT("SSN",SSN,0))
+6 IF '$TEST
QUIT "No SSN Index for "_SSN
+7 ;
+8 IF $ORDER(^DPT("SSN",SSN,0))=$ORDER(^DPT("SSN",SSN,""),-1)
+9 IF '$TEST
QUIT "Duplicate SSN in cross-ref "_SSN
+10 ;
+11 SET DFN=$ORDER(^DPT("SSN",SSN,0))
+12 ;
+13 IF $GET(^DPT(DFN,0))]""
+14 IF '$TEST
QUIT "No Zero node in DPT for SSN "_SSN
+15 ;
+16 IF $PIECE($GET(^DPT(DFN,0)),"^",9)=SSN
+17 IF '$TEST
QUIT "Bad SSN cross-ref "_SSN
+18 QUIT DFN
+19 ;
INIFLDS ; set up array of fields to be used in fm getsdiq call
+1 SET DGFLDS(1)=$PIECE($TEXT(FLDS1),";;",2)
+2 SET DGFLDS(2)=$PIECE($TEXT(FLDS2),";;",2)
+3 QUIT
+4 ;Retrieve:
+5 ; Name, Provider,Street Address [Line 1], Zip+4,
+6 ; Street Address [Line 2]
+7 ; Street Address [Line 3],City, State, Zip Code County,
+8 ; Temporary Address Active?,Temporary Street [Line 1],
+9 ; Temporary Address County, Temporary Zip+4,
+10 ; Temporary Street [Line 2], Temporary Street Address [Line 3], Temporary
+11 ; City, Temporary State, Temporary Zip Code, Temporary Address Start Date,
+12 ; Temporary Address End Date, Phone Number [Residence], Phone Number [Work]
FLDS1 ;;.01;.104;.111;.1112;.112;.113;.114;.115;.116;.117;.12105;.1211;.12111;.12112;.1212;.1213
FLDS2 ;;.1214;.1215;.1216;.1217;.1218;.1219;.131;.132;
+1 QUIT
SENDATA(DGTATION) ;
+1 ; dgline is the message line
+2 SET DGLINE=0
+3 SET DGDFN=""
+4 ; (2,dfn, field set up from fileman data merge, dfn is dfn_","
+5 FOR
SET DGDFN=$ORDER(^XTMP("DGALS",$JOB,"DATA",2,DGDFN))
IF 'DGDFN
QUIT
Begin DoDot:1
+6 DO SETMAIL^DG53293B(DGTATION,DGDFN)
+7 ;
+8 IF (($PIECE($HOROLOG,",",2))#10)
QUIT
+9 IF '$DATA(ZTQUEUED)
WRITE " ."
+10 ;
End DoDot:1
+11 ;final mailman set
+12 IF 'DGLINE
QUIT
+13 DO SMAIL^DG53293B(DGLINE)
+14 ;
+15 QUIT
