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

SDHPIB.m

Go to the documentation of this file. 
  1. SDHPIB ;PKE/ALB - Health Services R&D Caregiver Study Main Routine;
  1.  ;;5.3;Scheduling;**141**;March 12, 1996
  1.  ;
  1.  I $D(DUZ)'=11 DO  Q
  1.  .W !!,"Please set DUZ variables, D ^XUP"
  1.  ;
  1.  S SDTATION=+$$SITE^VASITE()
  1.  I 'SDTATION DO  Q
  1.  . W !!,"Could not find station number from VASITE" Q
  1.  ;
  1.  W !?3,">>> VA HSR&D Caregivers Survey <<< ",!
  1.  W !,"    Please queue to run at a none peak time."
  1.  W !,"    This extract will generate 2 mail messages to you"
  1.  W !,"    and to G.SD HPI EXTRACT@ISC-ALBANY.DOMAIN.EXT",!
  1.  ;
  1.  S ZTIO="",ZTRTN="START^SDHPIB"
  1.  S ZTDESC="SD*5.3*141 - VA HSR&D Caregivers Survey"
  1.  D ^%ZTLOAD,HOME^%ZIS
  1.  I $G(ZTSK) W !?30,"Task Number = ",ZTSK,!
  1.  Q
  1. START I $D(DUZ)'=11 W !!,"Please set DUZ variables, D ^XUP" Q
  1.  ;
  1.  S SDTATION=+$$SITE^VASITE()
  1.  I '$D(^XTMP("SDHPI","S",SDTATION)) W:'$D(ZTQUEUED) !,"No STATION data" Q
  1.  ;
  1.  S SDSTART=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  ;
  1.  K ^XTMP("SDHPI",$J,"DATA")
  1.  K ^XTMP("SDHPI",$J,"ERROR")
  1.  K ^XTMP("SDHPI","S",SDTATION,"DFN")
  1.  ;
  1.  I $D(^XTMP("SDHPI","S",SDTATION,"ERROR","NO DATA REQUESTED")) DO  QUIT
  1.  .;
  1.  . D FMAIL(0)
  1.  . I '$D(ZTQUEUED) W !!?3,">>>... all done"
  1.  ;
  1.  I '$D(ZTQUEUED) DO
  1.  .W !?3,">>> Looking up patients DFNs from SSNs  "
  1.  D GETDFN(SDTATION)
  1.  ;
  1.  I '$D(ZTQUEUED) DO
  1.  .W !!?3,">>> Looking up patients data from DFNs  "
  1.  D DIQLOOK(SDTATION)
  1.  ;
  1.  I '$D(ZTQUEUED) DO
  1.  .W !!?3,">>> Creating Mail message of patients data "
  1.  D SENDATA(SDTATION)
  1.  ;
  1.  I '$D(ZTQUEUED) DO
  1.  .W !!?3,">>> ....all done"
  1.  ;
  1.  ;mail summary
  1.  D FMAIL(1)
  1.  ;
  1.  K SDFIELD,SDN,SDP,SDPECE,SDSTART
  1.  K SDZ,SDFLDS,SDDFN,SDTATION,SDSSN,SDLINE
  1.  Q
  1. GETDFN(SDTATION) ;
  1.  ;From strings of SSNs get DFN's from DPT
  1.  ; go down station array
  1.  S SDN=0
  1.  F  S SDN=$O(^XTMP("SDHPI","S",SDTATION,SDN)) Q:'SDN  DO
  1.  .;;piece out ssn
  1.  .F SDP=1:1 S SDSSN=$P(^XTMP("SDHPI","S",SDTATION,SDN),"^",SDP) Q:'SDSSN  DO
  1.  . . S SDDFN=$$DFN(SDSSN)
  1.  . . I SDDFN S ^XTMP("SDHPI","S",SDTATION,"DFN",SDDFN)=SDSSN
  1.  . . E  S ^XTMP("SDHPI",$J,"ERROR","SSN",SDSSN)=SDDFN
  1.  . .;
  1.  . . I (($P($H,",",2))#20) Q
  1.  . . I '$D(ZTQUEUED) W "."
  1.  Q
  1. DIQLOOK(SDTATION) ;
  1.  ;
  1.  ; get array of fields to lookup
  1.  D INIFLDS
  1.  ; for each dfn call gets^diq
  1.  S SDDFN=0
  1.  F  S SDDFN=$O(^XTMP("SDHPI","S",SDTATION,"DFN",SDDFN)) Q:'SDDFN  DO
  1.  . D GETSDIQ(SDDFN)
  1.  .;
  1.  . I (($P($H,",",2))#3) Q
  1.  . I '$D(ZTQUEUED) W "."
  1.  .;
  1.  Q
  1. SENDATA(SDTATION) ;
  1.  ; sdline is the message line
  1.  S SDLINE=0
  1.  S SDDFN=""
  1.  ; (2,dfn, field  set up from fileman data merge, dfn is dfn_"," 
  1.  F  S SDDFN=$O(^XTMP("SDHPI",$J,"DATA",2,SDDFN)) Q:'SDDFN  DO 
  1.  . D SETMAIL(SDTATION,SDDFN)
  1.  .;
  1.  . I (($P($H,",",2))#10) Q
  1.  . I '$D(ZTQUEUED) W " ."
  1.  .;
  1.  ;final mailman set
  1.  Q:'SDLINE
  1.  D SMAIL(SDLINE)
  1.  ;
  1.  Q
  1. SETMAIL(SDTATION,SDDFN) ;
  1.  I SDLINE=0 D INITMAIL(1)
  1.  ;
  1.  S SDLINE=SDLINE+1
  1.  S SDPECE=1
  1.  ;
  1.  ; set first line of each record to station^ssn
  1.  S ^XMB(3.9,XMZ,2,SDLINE,0)=SDTATION_"^"_$P($G(^DPT(+SDDFN,0)),"^",9)_"^"
  1.  S SDLINE=SDLINE+1
  1.  ;
  1.  S SDFIELD=0
  1.  F  S SDFIELD=$O(^XTMP("SDHPI",$J,"DATA",2,SDDFN,SDFIELD)) Q:'SDFIELD  DO
  1.  . ;set mailmsg for 1 dfn
  1.  . I $$LINECALC(SDFIELD,SDLINE)>80 DO
  1.  . . ; make sure end piece has last ^
  1.  . . S $P(^XMB(3.9,XMZ,2,SDLINE,0),"^",SDPECE)=""
  1.  . . S SDLINE=SDLINE+1
  1.  . . S SDPECE=1
  1.  . D SETLINE
  1.  . S SDPECE=SDPECE+1
  1.  ;
  1.  ; make sure end piece has last ^
  1.  S $P(^XMB(3.9,XMZ,2,SDLINE,0),"^",SDPECE)=""
  1.  S SDLINE=SDLINE+1
  1.  ; set record delimiter
  1.  S ^XMB(3.9,XMZ,2,SDLINE,0)=">>>"
  1.  ;
  1.  Q
  1. LINECALC(SDFIELD,SDLINE) ;
  1.  ; return length that would be set
  1.  Q $L($G(^XTMP("SDHPI",$J,"DATA",2,SDDFN,SDFIELD,"E")))+$L($G(^XMB(3.9,XMZ,2,SDLINE,0)))
  1.  ;
  1.  ;
  1. SETLINE ;set mailmsg from xtmp array
  1.  ; $g will preserve piece position if field returned error
  1.  S $P(^XMB(3.9,XMZ,2,SDLINE,0),"^",SDPECE)=$G(^XTMP("SDHPI",$J,"DATA",2,SDDFN,SDFIELD,"E")) Q
  1.  ;
  1.  ;
  1. GETSDIQ(SDDFN) ;
  1.  K SDDATA,SDERR
  1.  ;
  1.  F SDFLDS=1:1:5 DO
  1.  . D GETS^DIQ(2,SDDFN,SDFLDS(SDFLDS),"E","SDDATA","SDERR")
  1.  .;
  1.  .; merge will set ,2,dfn_",",field,"E")=external value
  1.  .;
  1.  . M ^XTMP("SDHPI",$J,"DATA")=SDDATA
  1.  . K SDDATA
  1.  . I $D(SDERR) DO  K SDERR
  1.  . .;if a field has err whatodo
  1.  . .;
  1.  . .; check to see if each field was set in returned array 
  1.  . . F SDP=1:1 S SDFIELD=$P(SDFLDS(SDFLDS),";",SDP) Q:'SDFIELD  DO
  1.  . . .;
  1.  . . .;  indicates fileman returned error
  1.  . . . I '$D(^XTMP("SDHPI",$J,"DATA",2,SDDFN_",",SDFIELD,"E")) DO
  1.  . . . .;
  1.  . . . .; set it to null to keep the piece position in mail
  1.  . . . . S ^XTMP("SDHPI",$J,"DATA",2,SDDFN_",",SDFIELD,"E")=""
  1.  . . . .;
  1.  . . . .;the sderr array is set by fm in order of missing fields
  1.  . . . . S SDERR=$O(SDERR("DIERR",0)) I 'SDERR K SDERR Q
  1.  . . . . M ^XTMP("SDHPI",$J,"ERROR",SDDFN,SDFIELD)=SDERR("DIERR",SDERR)
  1.  . . . . S ^XTMP("SDHPI",$J,"ERROR",SDDFN,"SSN")=$P($G(^DPT(SDDFN,0)),"^",9)
  1.  . . . .;pop the array
  1.  . . . . K SDERR("DIERR",SDERR)
  1.  . . .;
  1.  ;
  1.  Q
  1.  ;
  1.  Q
  1. INITMAIL(FLAG) ;-- This function will initialize mail variables
  1.  ;
  1.  S XMSUB="SD*5.3*141 "_(+$$SITE^VASITE())_"VA HSR&D CAREGIVERS SURVEY"
  1.  S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
  1.  I $G(FLAG) DO
  1.  . S XMY("G.SD HPI EXTRACT@ISC-ALBANY.DOMAIN.EXT")=""
  1.  . S XMY("S.SD HPI EXTRACT@ISC-ALBANY.DOMAIN.EXT")=""
  1.  D GET^XMA2
  1.  Q
  1. SMAIL(SDLINE) ;-- Send Mail Message containing records so far
  1.  ;
  1.  ; INPUT TOTAL- Total Lines in Message
  1.  ;
  1.  S ^XMB(3.9,XMZ,2,0)="^3.92A^"_SDLINE_U_SDLINE_U_DT
  1.  D ENT1^XMD
  1.  D KILL^XM
  1.  Q
  1.  ;
  1. FMAIL(DATA) ;- This function will generate a summary mail message.
  1.  ;
  1.  S XMSUB="SD*5.3*141 "_(+$$SITE^VASITE())_"VA HSR&D Error Summary"
  1.  S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
  1.  S XMY("G.SD HPI EXTRACT@ISC-ALBANY.DOMAIN.EXT")=""
  1.  S XMY("S.SD HPI EXTRACT@ISC-ALBANY.DOMAIN.EXT")=""
  1.  ;
  1.  D GET^XMA2
  1.  S ^XMB(3.9,XMZ,2,1,0)="VA Health Services R&D Caregivers Survey completed."
  1.  S ^XMB(3.9,XMZ,2,2,0)=""
  1.  S ^XMB(3.9,XMZ,2,3,0)="Start Time: "_SDSTART
  1.  S ^XMB(3.9,XMZ,2,4,0)=" Stop Time: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S ^XMB(3.9,XMZ,2,5,0)=""
  1.  ;
  1.  S SDLINE=6
  1.  I 'DATA DO  QUIT
  1.  . S ^XMB(3.9,XMZ,2,SDLINE,0)="No data requested"
  1.  . D SMAIL(SDLINE)
  1.  ;
  1.  S SDZ=$Q(^XTMP("SDHPI",$J,"ERROR"))
  1.  I SDZ]"",SDZ[("""SDHPI"""_","_$J_","_"""ERROR""")
  1.  E  DO  QUIT
  1.  . S ^XMB(3.9,XMZ,2,SDLINE,0)=" Error Summary: No errors Found "
  1.  . D SMAIL(SDLINE)
  1.  ;
  1.  S ^XMB(3.9,XMZ,2,SDLINE,0)=" Error Summary: "
  1.  S SDLINE=SDLINE+1
  1.  S ^XMB(3.9,XMZ,2,SDLINE,0)="""ERR"_$P(SDZ,"ERROR",2)_" = "_@SDZ
  1.  ;
  1.  F  S SDZ=$Q(@SDZ) Q:SDZ']""  Q:SDZ'[("""SDHPI"""_","_$J_","_"""ERROR""")  DO
  1.  . S SDLINE=SDLINE+1
  1.  . S ^XMB(3.9,XMZ,2,SDLINE,0)="""ERR"_$P(SDZ,"ERROR",2)_" = "_@SDZ
  1.  .;
  1.  .;quit if this gets to be too much
  1.  . I SDLINE>500 S SDZ="ZZZEND"
  1.  D SMAIL(SDLINE)
  1.  Q
  1.  ;
  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 "Ambiguous SSN 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 SDFLDS(1)=$P($T(FLDS1),";;",2)
  1.  S SDFLDS(2)=$P($T(FLDS2),";;",2)
  1.  S SDFLDS(3)=$P($T(FLDS3),";;",2)
  1.  S SDFLDS(4)=$P($T(FLDS4),";;",2)
  1.  S SDFLDS(5)=$P($T(FLDS5),";;",2)
  1.  Q
  1. 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
  1. 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
  1. 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
  1. 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
  1. 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
  1.  Q