iSharkFly-Open
/
VistA-WorldVistAEHR
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
VistA-WorldVistAEHR/r/SCHEDULING-SD-SC/SDHPIB.m

261 lines
7.8 KiB
Mathematica
Raw Permalink Blame History

SDHPIB ;PKE/ALB - Health Services R&D Caregiver Study Main Routine;
;;5.3;Scheduling;**141**;March 12, 1996
;
I $D(DUZ)'=11 DO Q
.W !!,"Please set DUZ variables, D ^XUP"
;
S SDTATION=+$$SITE^VASITE()
I 'SDTATION DO Q
. W !!,"Could not find station number from VASITE" Q
;
W !?3,">>> VA HSR&D Caregivers Survey <<< ",!
W !," Please queue to run at a none peak time."
W !," This extract will generate 2 mail messages to you"
W !," and to G.SD HPI EXTRACT@ISC-ALBANY.VA.GOV",!
;
S ZTIO="",ZTRTN="START^SDHPIB"
S ZTDESC="SD*5.3*141 - VA HSR&D Caregivers Survey"
D ^%ZTLOAD,HOME^%ZIS
I $G(ZTSK) W !?30,"Task Number = ",ZTSK,!
Q
START I $D(DUZ)'=11 W !!,"Please set DUZ variables, D ^XUP" Q
;
S SDTATION=+$$SITE^VASITE()
I '$D(^XTMP("SDHPI","S",SDTATION)) W:'$D(ZTQUEUED) !,"No STATION data" Q
;
S SDSTART=$$FMTE^XLFDT($$NOW^XLFDT)
;
K ^XTMP("SDHPI",$J,"DATA")
K ^XTMP("SDHPI",$J,"ERROR")
K ^XTMP("SDHPI","S",SDTATION,"DFN")
;
I $D(^XTMP("SDHPI","S",SDTATION,"ERROR","NO DATA REQUESTED")) DO QUIT
.;
. D FMAIL(0)
. I '$D(ZTQUEUED) W !!?3,">>>... all done"
;
I '$D(ZTQUEUED) DO
.W !?3,">>> Looking up patients DFNs from SSNs "
D GETDFN(SDTATION)
;
I '$D(ZTQUEUED) DO
.W !!?3,">>> Looking up patients data from DFNs "
D DIQLOOK(SDTATION)
;
I '$D(ZTQUEUED) DO
.W !!?3,">>> Creating Mail message of patients data "
D SENDATA(SDTATION)
;
I '$D(ZTQUEUED) DO
.W !!?3,">>> ....all done"
;
;mail summary
D FMAIL(1)
;
K SDFIELD,SDN,SDP,SDPECE,SDSTART
K SDZ,SDFLDS,SDDFN,SDTATION,SDSSN,SDLINE
Q
GETDFN(SDTATION) ;
;From strings of SSNs get DFN's from DPT
; go down station array
S SDN=0
F S SDN=$O(^XTMP("SDHPI","S",SDTATION,SDN)) Q:'SDN DO
.;;piece out ssn
.F SDP=1:1 S SDSSN=$P(^XTMP("SDHPI","S",SDTATION,SDN),"^",SDP) Q:'SDSSN DO
. . S SDDFN=$$DFN(SDSSN)
. . I SDDFN S ^XTMP("SDHPI","S",SDTATION,"DFN",SDDFN)=SDSSN
. . E S ^XTMP("SDHPI",$J,"ERROR","SSN",SDSSN)=SDDFN
. .;
. . I (($P($H,",",2))#20) Q
. . I '$D(ZTQUEUED) W "."
Q
DIQLOOK(SDTATION) ;
;
; get array of fields to lookup
D INIFLDS
; for each dfn call gets^diq
S SDDFN=0
F S SDDFN=$O(^XTMP("SDHPI","S",SDTATION,"DFN",SDDFN)) Q:'SDDFN DO
. D GETSDIQ(SDDFN)
.;
. I (($P($H,",",2))#3) Q
. I '$D(ZTQUEUED) W "."
.;
Q
SENDATA(SDTATION) ;
; sdline is the message line
S SDLINE=0
S SDDFN=""
; (2,dfn, field set up from fileman data merge, dfn is dfn_","
F S SDDFN=$O(^XTMP("SDHPI",$J,"DATA",2,SDDFN)) Q:'SDDFN DO
. D SETMAIL(SDTATION,SDDFN)
.;
. I (($P($H,",",2))#10) Q
. I '$D(ZTQUEUED) W " ."
.;
;final mailman set
Q:'SDLINE
D SMAIL(SDLINE)
;
Q
SETMAIL(SDTATION,SDDFN) ;
I SDLINE=0 D INITMAIL(1)
;
S SDLINE=SDLINE+1
S SDPECE=1
;
; set first line of each record to station^ssn
S ^XMB(3.9,XMZ,2,SDLINE,0)=SDTATION_"^"_$P($G(^DPT(+SDDFN,0)),"^",9)_"^"
S SDLINE=SDLINE+1
;
S SDFIELD=0
F S SDFIELD=$O(^XTMP("SDHPI",$J,"DATA",2,SDDFN,SDFIELD)) Q:'SDFIELD DO
. ;set mailmsg for 1 dfn
. I $$LINECALC(SDFIELD,SDLINE)>80 DO
. . ; make sure end piece has last ^
. . S $P(^XMB(3.9,XMZ,2,SDLINE,0),"^",SDPECE)=""
. . S SDLINE=SDLINE+1
. . S SDPECE=1
. D SETLINE
. S SDPECE=SDPECE+1
;
; make sure end piece has last ^
S $P(^XMB(3.9,XMZ,2,SDLINE,0),"^",SDPECE)=""
S SDLINE=SDLINE+1
; set record delimiter
S ^XMB(3.9,XMZ,2,SDLINE,0)=">>>"
;
Q
LINECALC(SDFIELD,SDLINE) ;
; return length that would be set
Q $L($G(^XTMP("SDHPI",$J,"DATA",2,SDDFN,SDFIELD,"E")))+$L($G(^XMB(3.9,XMZ,2,SDLINE,0)))
;
;
SETLINE ;set mailmsg from xtmp array
; $g will preserve piece position if field returned error
S $P(^XMB(3.9,XMZ,2,SDLINE,0),"^",SDPECE)=$G(^XTMP("SDHPI",$J,"DATA",2,SDDFN,SDFIELD,"E")) Q
;
;
GETSDIQ(SDDFN) ;
K SDDATA,SDERR
;
F SDFLDS=1:1:5 DO
. D GETS^DIQ(2,SDDFN,SDFLDS(SDFLDS),"E","SDDATA","SDERR")
.;
.; merge will set ,2,dfn_",",field,"E")=external value
.;
. M ^XTMP("SDHPI",$J,"DATA")=SDDATA
. K SDDATA
. I $D(SDERR) DO K SDERR
. .;if a field has err whatodo
. .;
. .; check to see if each field was set in returned array
. . F SDP=1:1 S SDFIELD=$P(SDFLDS(SDFLDS),";",SDP) Q:'SDFIELD DO
. . .;
. . .; indicates fileman returned error
. . . I '$D(^XTMP("SDHPI",$J,"DATA",2,SDDFN_",",SDFIELD,"E")) DO
. . . .;
. . . .; set it to null to keep the piece position in mail
. . . . S ^XTMP("SDHPI",$J,"DATA",2,SDDFN_",",SDFIELD,"E")=""
. . . .;
. . . .;the sderr array is set by fm in order of missing fields
. . . . S SDERR=$O(SDERR("DIERR",0)) I 'SDERR K SDERR Q
. . . . M ^XTMP("SDHPI",$J,"ERROR",SDDFN,SDFIELD)=SDERR("DIERR",SDERR)
. . . . S ^XTMP("SDHPI",$J,"ERROR",SDDFN,"SSN")=$P($G(^DPT(SDDFN,0)),"^",9)
. . . .;pop the array
. . . . K SDERR("DIERR",SDERR)
. . .;
;
Q
;
Q
INITMAIL(FLAG) ;-- This function will initialize mail variables
;
S XMSUB="SD*5.3*141 "_(+$$SITE^VASITE())_"VA HSR&D CAREGIVERS SURVEY"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
I $G(FLAG) DO
. S XMY("G.SD HPI EXTRACT@ISC-ALBANY.VA.GOV")=""
. S XMY("S.SD HPI EXTRACT@ISC-ALBANY.VA.GOV")=""
D GET^XMA2
Q
SMAIL(SDLINE) ;-- Send Mail Message containing records so far
;
; INPUT TOTAL- Total Lines in Message
;
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_SDLINE_U_SDLINE_U_DT
D ENT1^XMD
D KILL^XM
Q
;
FMAIL(DATA) ;- This function will generate a summary mail message.
;
S XMSUB="SD*5.3*141 "_(+$$SITE^VASITE())_"VA HSR&D Error Summary"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
S XMY("G.SD HPI EXTRACT@ISC-ALBANY.VA.GOV")=""
S XMY("S.SD HPI EXTRACT@ISC-ALBANY.VA.GOV")=""
;
D GET^XMA2
S ^XMB(3.9,XMZ,2,1,0)="VA Health Services R&D Caregivers Survey completed."
S ^XMB(3.9,XMZ,2,2,0)=""
S ^XMB(3.9,XMZ,2,3,0)="Start Time: "_SDSTART
S ^XMB(3.9,XMZ,2,4,0)=" Stop Time: "_$$FMTE^XLFDT($$NOW^XLFDT)
S ^XMB(3.9,XMZ,2,5,0)=""
;
S SDLINE=6
I 'DATA DO QUIT
. S ^XMB(3.9,XMZ,2,SDLINE,0)="No data requested"
. D SMAIL(SDLINE)
;
S SDZ=$Q(^XTMP("SDHPI",$J,"ERROR"))
I SDZ]"",SDZ[("""SDHPI"""_","_$J_","_"""ERROR""")
E DO QUIT
. S ^XMB(3.9,XMZ,2,SDLINE,0)=" Error Summary: No errors Found "
. D SMAIL(SDLINE)
;
S ^XMB(3.9,XMZ,2,SDLINE,0)=" Error Summary: "
S SDLINE=SDLINE+1
S ^XMB(3.9,XMZ,2,SDLINE,0)="""ERR"_$P(SDZ,"ERROR",2)_" = "_@SDZ
;
F S SDZ=$Q(@SDZ) Q:SDZ']"" Q:SDZ'[("""SDHPI"""_","_$J_","_"""ERROR""") DO
. S SDLINE=SDLINE+1
. S ^XMB(3.9,XMZ,2,SDLINE,0)="""ERR"_$P(SDZ,"ERROR",2)_" = "_@SDZ
.;
.;quit if this gets to be too much
. I SDLINE>500 S SDZ="ZZZEND"
D SMAIL(SDLINE)
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 "Ambiguous SSN 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 SDFLDS(1)=$P($T(FLDS1),";;",2)
S SDFLDS(2)=$P($T(FLDS2),";;",2)
S SDFLDS(3)=$P($T(FLDS3),";;",2)
S SDFLDS(4)=$P($T(FLDS4),";;",2)
S SDFLDS(5)=$P($T(FLDS5),";;",2)
Q
FLDS1 ;;.01;.02;.03;.033;.05;.06;.07;.08;.09;.103;.104;.1041;.105;.111;.1112;.112;.113;.114;.115;.116;.117;.12105;.1211;.12111;.12112;.1212;.1213;.1214;.1215;.1216;.1217;.1218;.1219
FLDS2 ;;.131;.132;.14;.21011;.211;.211011;.212;.2125;.213;.214;.215;.216;.217;.218;.219;.2191;.2192;.21925;.2193;.2194;.2195;.2196;.2197;.2198;.2199
FLDS3 ;;.2401;.2402;.2403;.251;.2514;.2515;.252;.253;.254;.255;.256;.257;.258;.291;.2911;.2912;.2913;.2914;.2915;.2916;.2917;.2918;.2919;.292;.2921;.2922;.2923;.2924;.2925;.2926;.2927;.2928;.2929;.293
FLDS4 ;;.301;.3192;.323;.33011;.3305;.331;.331011;.3311;.3312;.3313;.3314;.3315;.3316;.3317;.3318;.3319;.332;.333;.334;.335;.336;.337;.338;.339;.34011;.3405;.341;.342;.343;.344;.345;.346;.347;.348;.349;.351
FLDS5 ;;.3601;.36205;.3621;.36215;.3622;.36225;.3623;.36235;.3624;.3625;.36255;.3626;.36265;.3627;.36275;.3628;.36285;.3629;.36295;.525;.5291;57.4;148;1901
Q
Reference in New Issue View Git Blame Copy Permalink