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

DVBAVRX2.m

Go to the documentation of this file. 
  1. DVBAVRX2 ;ALB/GAK - CAPRI BACKGROUND JOB1 FOR VOCREHAB ;06/21/2012 12:00pm
  1.  ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38
  1.  ;
  1.  Q  ;NO DIRECT ENTRY
  1.  ;
  1. JOB1 ;PROCESS NEW REQUESTS AND SEND MAILMAN MESSAGES FOR AGED REQUESTS
  1.  ;
  1.  N %H,X,Y,%Y,DAT
  1.  N DVBADAT,DVBAIEN
  1.  N DVBAFARY   ;FORM ARRAY FOR GETS
  1.  N DVBAFERR   ;FORM ARRAY ERROR ARRAY
  1.  N DVBAPOC,DVBARDAT,DVBAPNAM,DVBAPDFN,DVBAPSSN,DVBAPSDT,DVBASNTL
  1.  N DVBAOK   ;OKAY TO PASS PII TO MAILMAN MESSAGE
  1.  N DVBAGERR   ;GET1 ERROR ARRAY
  1.  N DVBAXIEN   ;WORKING VARIABLE TO ADD "," TO END OF IEN FOR GETS/GET1
  1.  N DVBAVRRA   ;DVBA VOCREHAB REQUESTOR EMAIL ADDRESS FROM #200,.151 - EXCHANGE EMAIL ADDRESS
  1.  N DVBATD   ;TODAY
  1.  N DVBATAG   ;TEST AGE
  1.  N DVBASWSD   ;SWITCH FOR DATE (0 OR 1)
  1.  N DVBAFARY,ERROR    ;FORM ARRAY
  1.  N DATENG   ;DATE IN ENGLISH
  1.  N DVBADOW    ;DAY OF WEEK
  1.  N DVBAAGE,DVBAXAGE
  1.  N DVBAEMA    ;WORKING VARIABLE FOR EMAIL ADDRESS
  1.  N DVBARPTD   ;REPORT FORMAT DATE AND TIME
  1.  N MAILSUBLN
  1.  ;
  1.  S (%H,DAT)=+$H D YMD^%DTC    ; CONVERT $H TO FILEMAN DATE
  1.  S DVBATD=X
  1.  F DVBAXAGE=5,6,7 D
  1.  . K DVBAAGE
  1.  . ;BUILD AGE ARRAY
  1.  . D WWDA(DVBATD,DVBAXAGE)
  1.  . S J="" F  S J=$O(DVBAAGE(J)) Q:J=""  D
  1.  .. S DVBASWSD=0
  1.  .. S DVBADAT=$P(DVBAAGE(J),"^",2)_".0000001"
  1.  .. F  S DVBADAT=$O(^DVB(396.9,"ARSDT","N",DVBADAT)) Q:DVBADAT=""!(DVBASWSD=1)  D
  1.  ... S DVBATAG=$P(DVBADAT,".",1) I DVBATAG'=$P(DVBAAGE(J),"^",2) S DVBASWSD=1 Q
  1.  ... S DVBAIEN="" F  S DVBAIEN=$O(^DVB(396.9,"ARSDT","N",DVBADAT,DVBAIEN)) Q:DVBAIEN=""  D
  1.  .... K DVBAFARY,DVBAFERR
  1.  .... K DVBAPOC,DVBARDAT,DVBAPNAM,DVBAPDFN,DVBAPSSN,DVBAPSDT,DVBAOK
  1.  .... S DVBAOK=0
  1.  .... D GETS^DIQ(396.9,DVBAIEN_",","*","IE","DVBAFARY","DVBAFERR")
  1.  .... ;
  1.  .... S DVBASNTL=$G(DVBAFARY(396.9,DVBAIEN_",",1,"E"))   ;SEND TO LOCATION
  1.  .... S DVBAPOC=$G(DVBAFARY(396.9,DVBAIEN_",",11,"I"))   ;POINT OF CONTACT IEN
  1.  .... S DVBARDAT=$G(DVBAFARY(396.9,DVBAIEN_",",.01,"E"))   ;REQUEST DATE
  1.  .... S DVBAPNAM=$G(DVBAFARY(396.9,DVBAIEN_",",4,"E"))   ;PATIENT NAME
  1.  .... S DVBAPDFN=$G(DVBAFARY(396.9,DVBAIEN_",",4,"I"))   ;PATIENT DFN
  1.  .... ;ICR# FOR #2;.09 - no IA needed for this file
  1.  .... S DVBAPSDT=DVBAFARY(396.9,DVBAIEN_",",9,"E")   ;PREFERRED SCHEDULE DATE   [2;3] [D]
  1.  .... S MAILSUBLN="VOC REHAB REQUEST IS NOW "_DVBAXAGE_" DAYS OLD"
  1.  .... I DVBAXAGE=5!(DVBAXAGE=6) D
  1.  ..... S DVBAOK=1
  1.  ..... S DVBAEMA="G.DVBA VR VOCREHAB PERSONNEL"
  1.  ..... D NFYAGE
  1.  ..... ;
  1.  .... I DVBAXAGE=7 D
  1.  ..... ;ICR# (10060) FOR #200;.151 - no IA needed for this file
  1.  ..... S DVBAXIEN=DVBAIEN_","
  1.  ..... S DVBAVRRA=$$GET1^DIQ(200,DVBAFARY(396.9,DVBAXIEN,11,"I"),.151,"","","DVBAGERR")
  1.  ..... I $D(DVBAGERR) Q
  1.  ..... Q:DVBAVRRA=""
  1.  ..... S DVBAEMA=DVBAVRRA
  1.  ..... D NFYAGE
  1.  ;
  1.  Q
  1.  ;
  1. NFYAGE ;SETUP MAILMAN MESSAGE BASED ON JOB1 VARIABLES
  1.  ;
  1.  Q:DVBAEMA=""
  1.  N XMSUB,XMTEXT,XMY,XMDUZ,XMDUN,XMZ,XMMG
  1.  N DVBAMMT   ;MAILMAN MESSAGE TEXT ARRAY
  1.  N DVBASTT   ;START TIME STAMP
  1.  N C,D,D0,DA,DI,DIC,DIE,DILOCKTM,DISYS,DQ,DR,X,Y,%
  1.  ;
  1.  S %H=$H D YX^%DTC S X=X_% S DVBASTT=$$FMTE^XLFDT(X,"5FPZ")
  1.  S XMDUZ="VOCREHAB POSTMASTER"
  1.  S XMSUB="Chapter 31 Referral for Medical Services has aged "_DVBAXAGE_" days"
  1.  S XMY(DVBAEMA)=""
  1.  S XMTEXT="DVBAMMT("
  1.  S DVBAMMT(1)="Sent: "_DVBASTT
  1.  S DVBAMMT(2)="To: "_DVBAEMA
  1.  S DVBAMMT(3)="Subject: "_XMSUB
  1.  S DVBAMMT(4)=""
  1.  S DVBAMMT(5)="            REQUEST DATE: "_DVBARDAT
  1.  S DVBAMMT(6)="            PATIENT  DFN: `"_DVBAPDFN
  1.  S DVBAMMT(7)=" PREFERRED SCHEDULE DATE: "_DVBAPSDT
  1.  S DVBAMMT(7.5)=""
  1.  S DVBAMMT(8)="THE 'NEW' STATUS ON THIS FORM 28-8861 HAS NOW AGED "_DVBAXAGE_" DAYS"
  1.  S DVBAMMT(9)="PLEASE MAKE SURE PATIENT HAS CONSULT LINKED TO FORM."
  1.  S DVBAMMT(10)=""
  1.  S DVBAMMT(11)="**NOTE: To view the patient using the DFN, paste the DFN number into the"
  1.  S DVBAMMT(12)="CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to"
  1.  S DVBAMMT(13)="include the ' (backward-apostrophe) character."
  1.  ;
  1.  D XMZ^XMA2
  1.  D ^XMD
  1.  ;
  1.  Q
  1.  ;
  1. WWDA(DVBATD,DVBAXAGE)   
  1.  ;
  1.  ;WORK WEEK DAY AGING
  1.  ; RETURNS   THE DATES TO WRITE EMAILS FOR
  1.  ; DVBATD    TODAY IS THE DATE THE FUNCTION IS RUNNING FOR
  1.  ; DVBAAGE   AGE IS THE NUMBER OF DAYS TO AGE FOR (5, 6, OR 7) ONLY
  1.  ; SPECIAL DAYS OF THE WEEK ARE MON, FRIDAY, AND TUESDAY
  1.  ;
  1.  ;IS DAT A WEEKEND DAY?
  1.  ;
  1.  ;S DVBAAGE(5)=""   ; MON=MON, TUE=TUE, ...
  1.  ;                  ; FRIDAY LOOKS FOR ALL SAT AND SUN FORM 8861 ENTRIES 5 DAYS OLD
  1.  ;S DVBAAGE(6)=""   ; MON=FRI, TUE=MON, WED=TUE, THR=WED, FRI=THR
  1.  ;                  ; MONDAY LOOKS FOR ALL SAT AND SUN FORM 8861 ENTRIES 6 DAYS OLD
  1.  ;S DVBAAGE(7)=""   ; MON=THR, TUE=FRI, WED=MON, THR=TUE, FRI=WED
  1.  ;                  ; TUESDAY LOOKS FOR ALL SAT AND SUN FORM 8861 ENTRIES 7 DAYS OLD
  1.  ;
  1.  N %Y,X,X1,X2
  1.  N J,DVBADOW
  1.  K DVBAAGE
  1.  ;
  1.  S X=DVBATD
  1.  ;RETURN TODAY'S DAY OF THE WEEK (0-6)/(SUN - SAT)
  1.  D DW^%DTC
  1.  S DVBADOW=%Y
  1.  ; 
  1.  ;DO NOT RUN ON DOW 0 OR 6
  1.  I DVBADOW=0!(DVBADOW=6) Q ""
  1.  ;
  1.  I DVBADOW=1&(DVBAXAGE=5) S DVBAAGE("MON")=-7
  1.  I DVBADOW=1&(DVBAXAGE=6) S DVBAAGE("FRI")=-10
  1.  I DVBADOW=1&(DVBAXAGE=6) S DVBAAGE("SAT")=-9
  1.  I DVBADOW=1&(DVBAXAGE=6) S DVBAAGE("SUN")=-8
  1.  I DVBADOW=1&(DVBAXAGE=7) S DVBAAGE("THR")=-11
  1.  ;
  1.  I DVBADOW=2&(DVBAXAGE=5) S DVBAAGE("TUE")=-7
  1.  I DVBADOW=2&(DVBAXAGE=6) S DVBAAGE("MON")=-8
  1.  I DVBADOW=2&(DVBAXAGE=7) S DVBAAGE("FRI")=-11
  1.  I DVBADOW=2&(DVBAXAGE=7) S DVBAAGE("SAT")=-10
  1.  I DVBADOW=2&(DVBAXAGE=7) S DVBAAGE("SUN")=-9
  1.  ;
  1.  I DVBADOW=3&(DVBAXAGE=5) S DVBAAGE("WED")=-7
  1.  I DVBADOW=3&(DVBAXAGE=6) S DVBAAGE("TUE")=-8
  1.  I DVBADOW=3&(DVBAXAGE=7) S DVBAAGE("MON")=-9
  1.  ;
  1.  I DVBADOW=4&(DVBAXAGE=5) S DVBAAGE("THR")=-7
  1.  I DVBADOW=4&(DVBAXAGE=6) S DVBAAGE("WED")=-8
  1.  I DVBADOW=4&(DVBAXAGE=7) S DVBAAGE("TUE")=-9
  1.  ;
  1.  I DVBADOW=5&(DVBAXAGE=5) S DVBAAGE("FRI")=-7
  1.  I DVBADOW=5&(DVBAXAGE=5) S DVBAAGE("SAT")=-6
  1.  I DVBADOW=5&(DVBAXAGE=5) S DVBAAGE("SUN")=-5
  1.  I DVBADOW=5&(DVBAXAGE=6) S DVBAAGE("THR")=-8
  1.  I DVBADOW=5&(DVBAXAGE=7) S DVBAAGE("WED")=-9
  1.  ;
  1.  S J="" F  S J=$O(DVBAAGE(J)) Q:J=""  D
  1.  . S X1=DVBATD
  1.  . S X2=DVBAAGE(J)
  1.  . D C^%DTC
  1.  . S $P(DVBAAGE(J),"^",2)=X
  1.  ;
  1.  Q
  1.  ;