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

DVBAVRX1.m

Go to the documentation of this file. 
  1. DVBAVRX1 ;ALB/GAK - CAPRI BACKGROUND JOB2 AND RPC ENTRY POINT FOR VOCREHAB ;06/21/2012 12:00pm
  1.  ;;2.7;AMIE;**181,184**;Apr 10, 1995;Build 10
  1.  ;
  1.  Q  ;NO DIRECT ENTRY
  1.  ;
  1.  ; RUN FROM TASK MANAGER (BACKGROUND BATCH JOB)
  1.  ; BACKGROUND JOB SHOULD BE RUN ON SAME DAY AS DATA ENTRY AT THE END OF THE BUSINESS DAY
  1.  ; CALL INDIVIDUAL TAGS FROM RPC (MAILMAN NOTIFY - REALTIME)
  1.  ;
  1.  ;FOR BUILD:
  1.  ;   MAILMAN GROUP -> "DVBA VR VOCREHAB PERSONNEL"
  1.  ;   OPTION FILE OPTION -> "DVBA VR BACKGROUND"
  1.  ;   RPC -> NEW REQUEST
  1.  ;   RPC -> CANCELLED REQUEST
  1.  ;   RPC -> COMPLETED REQUEST
  1.  ;   RPC -> PENDING REQUEST
  1.  ;
  1. EN ; TASKMAN ENTER POINT FOR BACKGROUND JOB
  1.  ;
  1.  D JOB1^DVBAVRX2   ; For "N"ew status based on the INDEX - age entries and alert users of un-linked requests.  
  1.  D JOB2   ; LOOK AT STATUS OF FILE 123 --> 100.01 AND WORK MAIL NOTIFICATIONS
  1.  ;
  1.  Q
  1.  ;
  1. JOB2 ;JOB 2 WILL LOOK AT STATUS OF CONSULTS LINKED TO 8861
  1.  ;   WHEN ALL CONSULTS AS CANCELLED - FORM 8861 WILL BE CANCELLED
  1.  ;   WHEN A CONSULT IS COMPLETED AND IS THE ONLY CONSULT LINKED TO THE FORM - FORM 8861 WILL BE COMPLETED
  1.  ;   WHEN A CONSULT IS COMPLETED AND ALL OTHER CONSULTS ARE COMPLETE OR CANCLLED - FORM 8861 WILL BE COMPLETED
  1.  ;
  1.  N %H,DAT,X,J
  1.  N DVBADAT,DVBAIEN,DVBAIENX
  1.  N DVBACARY   ;CONSULTS ARRAY
  1.  N DVBACERR   ;CONSULTS GETS ERROR ARRAY
  1.  N DVBAIENT   ;IEN OF FORM 8831 CONTAINED IN THE CONSULTS ARRAY (TOP)
  1.  N DVBAMLTN   ;SEQUENCE NUMBER OF FORM 8861 MULTI CONTAINED IN THE CONSULTS ARRAY (MULTI SEQUENTIAL NUMBER)
  1.  N DVBATMP1   ;TEMP ARRAY 1 - CONSULTS MULTI
  1.  N DVBARCST   ;CONSULT/REQUEST STATUS --> 100.01,.001
  1.  N DVBAVRST   ;VOCREHAB STATUS OF MULTI (396.914,.02)
  1.  N DVBARKEY   ;REVERSE THE IEN KEYS AGAIN
  1.  N DVBACC     ;ARRAY FOR CANCELLED / COMPLETE LOGIC
  1.  N DVBAFDA    ;UPDATE API ARRAY
  1.  N DVBATD     ;TODAY'S DATE
  1.  N DVBACAN,DVBACOM
  1.  ;
  1.  S DVBADAT="" F  S DVBADAT=$O(^DVB(396.9,"ARSDT","P",DVBADAT)) Q:DVBADAT=""  D
  1.  . S DVBAIEN="" F  S DVBAIEN=$O(^DVB(396.9,"ARSDT","P",DVBADAT,DVBAIEN)) Q:DVBAIEN=""  D
  1.  .. ;GET CONSULT INFO AND BUILD CONSULT ARRAY
  1.  .. K DVBATMP1
  1.  .. K DVBACARY
  1.  .. D GETS^DIQ(396.9,DVBAIEN,"14*","IE","DVBACARY","DVBACERR")
  1.  .. S J="" F  S J=$O(DVBACARY(396.914,J)) Q:J=""  D
  1.  ... S DVBAIENT=$P(J,",",2)   ;SHOULD ALWAYS BE THE SAME AS IEN
  1.  ... S DVBAMLTN=$P(J,",",1)
  1.  ... ;BUILD TEMP ARRAY OF MULTI
  1.  ... S DVBATMP1(DVBAIENT,DVBAMLTN,.01,"I")=$G(DVBACARY(396.914,J,.01,"I"))
  1.  ... S DVBATMP1(DVBAIENT,DVBAMLTN,.02,"I")=$G(DVBACARY(396.914,J,.02,"I"))
  1.  .. ;WORK TEMP ARRAY
  1.  .. ;$P1 = VALUE FORM FORM ARRAY ^ $P2 = VALUE FROM CONSULTS -> STATUS #123; field 8 (internal value)
  1.  .. S DVBAIENT=""
  1.  .. K DVBACC
  1.  .. F  S DVBAIENT=$O(DVBATMP1(DVBAIENT)) Q:DVBAIENT=""  D
  1.  ... S DVBAMLTN=""
  1.  ... F  S DVBAMLTN=$O(DVBATMP1(DVBAIENT,DVBAMLTN)) Q:DVBAMLTN=""  D
  1.  .... S DVBARKEY=DVBAMLTN_","_DVBAIENT
  1.  .... S DVBAVRST=$$GET1^DIQ(396.914,DVBARKEY,.02,"I")
  1.  .... ;ICR #4110 
  1.  .... S DVBAIENX=DVBATMP1(DVBAIENT,DVBAMLTN,.01,"I")
  1.  .... S DVBARCST=$$GET1^DIQ(123,DVBAIENX,8,"I")   ;IEN OF THE 123 FILE VR IS POINTING TO
  1.  .... ;
  1.  .... I DVBARCST=1 S DVBACC(DVBARCST)=""
  1.  .... I DVBARCST=2 S DVBACC(DVBARCST)=""
  1.  .... I DVBARCST'=1&(DVBARCST'=2) S DVBACC(0)=""
  1.  .... ;
  1.  .... I DVBARCST'=DVBAVRST D   ;UPDATE VOCREHAB LAST STATUS
  1.  ..... K DVBAFDA
  1.  ..... S DVBAFDA(1,396.914,DVBARKEY_",",.02)=DVBARCST
  1.  ..... ;IRC #875 - points to 100.01
  1.  ..... D UPDATE^DIE("","DVBAFDA(1)","","DVBAUERR")
  1.  ..... I $D(DVBAUERR) Q
  1.  ... S DVBACOM=0 ;COMPLETED SWITCH
  1.  ... S DVBACAN=0 ;CANCELLED SWITCH
  1.  ... D   ;multi logic, should it ever be needed
  1.  .... I $D(DVBACC(0)) Q
  1.  .... I $D(DVBACC(1))&($D(DVBACC(2))) S DVBACOM=1 Q
  1.  .... I $D(DVBACC(1)) S DVBACAN=1 Q
  1.  .... I $D(DVBACC(2)) S DVBACOM=1 Q
  1.  ... I DVBACAN=1 D
  1.  .... K DVBAFDA,DVBAUERR
  1.  .... S DVBAFDA(1,396.9,DVBAIENT_",",13)="X"
  1.  .... K %H,DAT,X
  1.  .... S (%H,DAT)=+$H D YMD^%DTC   ;CONVERT $H TO FILEMAN DATE
  1.  .... S DVBAFDA(1,396.9,DVBAIENT_",",15)=X
  1.  .... S DVBAFDA(1,396.9,DVBAIENT_",",16)="OTH"
  1.  .... D UPDATE^DIE("","DVBAFDA(1)","","DVBAUERR")
  1.  .... I $D(DVBAUERR) Q
  1.  .... D RPCIN(DVBAIEN,"CAN")
  1.  ... I DVBACOM=1 D
  1.  .... K DVBAFDA,DVBAUERR
  1.  .... S DVBAFDA(1,396.9,DVBAIENT_",",13)="C"
  1.  .... K %H,DAT,X
  1.  .... S (%H,DAT)=+$H D YMD^%DTC   ;CONVERT $H TO FILEMAN DATE
  1.  .... S DVBAFDA(1,396.9,DVBAIENT_",",2)=X
  1.  .... D UPDATE^DIE("","DVBAFDA(1)","","DVBAUERR")
  1.  .... I $D(DVBAUERR) Q
  1.  .... D RPCIN(DVBAIEN,"COM")
  1.  ;
  1.  Q
  1.  ;
  1. RPCIN(DVBAFIEN,DVBATYPE) ;ENTER (IN) POINT FOR RPC CALLS
  1.  ;
  1.  ;Parameters Passed In
  1.  ;DVBAFIEN   The IEN of the 8861 Form
  1.  ;DVBATYPE   The type of the mailman message to be sent
  1.  ;           'NEW'
  1.  ;           'PENDING'
  1.  ;           'CANCELLED'
  1.  ;
  1.  N XMDUZ,DVBADUZ
  1.  ;
  1.  I '$D(DUZ) Q
  1.  ;
  1.  S XMDUZ=$P(^VA(200,DUZ,0),"^",1)_" CAPRI"
  1.  S DVBADUZ=DUZ
  1.  ;
  1.  I DVBATYPE="NEW" D NFY(DVBAFIEN,"NEW") Q
  1.  I DVBATYPE="PND" D NFY(DVBAFIEN,"PND") Q
  1.  I DVBATYPE="COM" D NFY(DVBAFIEN,"COM") Q
  1.  I DVBATYPE="CAN" D NFY(DVBAFIEN,"CAN") Q
  1.  ;
  1.  Q
  1.  ;
  1. NFY(DVBAFIEN,DVBATYPE) ;SETUP MAILMAN MESSAGE BASED ON REQUEST FORM IEN
  1.  ;D GETS^DIQ TO POPULATE REQUEST INFO
  1.  ;
  1.  N Y,%H,%
  1.  N XMSUB,XMTEXT,XMY,XMDUN,XMZ,XMMG
  1.  N DVBAFARY,DVBAFERR,DVBASTT,DVBAVRRA,DVBAGERR
  1.  N DVBAPOC,DVBARDAT,DVBAPDFN,DVBAPNAM,DVBARSTT,DVBASNTL,DVBAXIEN
  1.  N DVBAMMT,DVBAEMA
  1.  N DVBANXLN,DVBAXXEN
  1.  N C,D,D0,DA,DI,DIC,DIE,DILOCKTM,DISYS,DQ,DR,X
  1.  ;
  1.  N DUZ
  1.  S DUZ=.5   ;POSTMASTER
  1.  ;SINCE MAILMAN DOES NOT ALLOW MESSAGES TO BE SENT FROM USERS WITHOUT ACCESS CODES OR MAILBOXES
  1.  ;WHICH CAPRI REMOTE USER DO NOT HAVE, WE HAVE TO NEW DUZ AND CHANGE XMDUZ TO THE NAME OF THE USER
  1.  ;AS A STRING SO THE PROCESS IS STILL LINKED TO THE USER SENDING/TRIGGERING THE MESSAGE
  1.  ;
  1.  D GETS^DIQ(396.9,DVBAFIEN,"*","IE","DVBAFARY","DVBAFERR")
  1.  I $D(DVBAFERR) Q
  1.  ;
  1.  S DVBAPOC=$G(DVBAFARY(396.9,DVBAFIEN_",",11,"I"))
  1.  S DVBARDAT=$G(DVBAFARY(396.9,DVBAFIEN_",",.01,"E"))
  1.  S DVBAPDFN=$G(DVBAFARY(396.9,DVBAFIEN_",",4,"I"))
  1.  S DVBARSTT=$G(DVBAFARY(396.9,DVBAFIEN_",",13,"E"))
  1.  S DVBASNTL=$G(DVBAFARY(396.9,DVBAFIEN_",",1,"E"))
  1.  ;
  1.  S %H=$H D YX^%DTC S X=X_% S DVBASTT=$$FMTE^XLFDT(X,"5FPZ")
  1.  S XMSUB="CAPRI: Chapter 31 Referral for Medical Services New"
  1.  ;
  1.  S XMY("G.DVBA VR VOCREHAB PERSONNEL")=""
  1.  S DVBAEMA="DVBA VR VOCREHAB PERSONNEL"
  1.  ;
  1.  I DVBATYPE="NEW" D XNEW
  1.  I DVBATYPE="PND" D XPND
  1.  I DVBATYPE="COM" D XCOM
  1.  I DVBATYPE="CAN" D XCAN
  1.  ;
  1.  Q:DVBATYPE="NEW"
  1.  ;
  1.  K XMY
  1.  ;
  1.  S DVBAXXEN=DVBAFARY(396.9,DVBAFIEN_",",11,"I")
  1.  S DVBAVRRA=$$GET1^DIQ(200,DVBAXXEN,.151,"","","DVBAGERR")
  1.  I $D(DVBAGERR) Q
  1.  S DVBAEMA=DVBAVRRA
  1.  I DVBAEMA="" Q
  1.  S XMY(DVBAEMA)=""
  1.  ;
  1.  I DVBATYPE="PND" D XPND
  1.  I DVBATYPE="COM" D XCOM
  1.  I DVBATYPE="CAN" D XCAN
  1.  ;
  1.  Q
  1.  ;
  1. XNEW ;
  1.  ;
  1.  S XMSUB="CAPRI: Chapter 31 Referral for Medical Services New"
  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)="The following veteran has a New Chapter 31, FORM 28-8861"
  1.  S DVBAMMT(6)=""
  1.  S DVBANXLN=""
  1.  S DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$E("            ",1,12-$L(DVBAPDFN))_" "
  1.  S DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT
  1.  S DVBAMMT(7)=DVBANXLN
  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. XCOM ;
  1.  ;
  1.  S XMSUB="CAPRI: Chapter 31 Referral for Medical Services Completed"
  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)="The following veteran has a Completed Chapter 31, FORM 28-8861"
  1.  S DVBAMMT(6)=""
  1.  S DVBANXLN=""
  1.  S DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$E("            ",1,12-$L(DVBAPDFN))_" "
  1.  S DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT
  1.  S DVBAMMT(7)=DVBANXLN
  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.  ;CALL FUNCTION TO BUILD A 'TEXT TO DISPLAY' ARRAY OF CONSULTS
  1.  ;
  1.  D XMZ^XMA2
  1.  D ^XMD
  1.  ;
  1.  Q
  1.  ;
  1. XCAN ;
  1.  ;
  1.  S XMSUB="CAPRI: Chapter 31 Referral for Medical Services Cancelled"
  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)="The following veteran has a Cancelled Chapter 31, FORM 28-8861"
  1.  S DVBAMMT(6)=""
  1.  S DVBANXLN=""
  1.  S DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$E("            ",1,12-$L(DVBAPDFN))_" "
  1.  S DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT
  1.  S DVBAMMT(7)=DVBANXLN
  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.  ;CALL FUNCTION TO BUILD A 'TEXT TO DISPLAY' ARRAY OF CONSULTS
  1.  ;
  1.  D XMZ^XMA2
  1.  D ^XMD
  1.  ;
  1.  Q
  1.  ;
  1. XPND ;
  1.  ;
  1.  S XMSUB="CAPRI: Chapter 31 Referral for Medical Services Pending"
  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)="The following veteran has a Pending Chapter 31, FORM 28-8861"
  1.  S DVBAMMT(6)=""
  1.  S DVBANXLN=""
  1.  S DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$E("            ",1,12-$L(DVBAPDFN))_" "
  1.  S DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT
  1.  S DVBAMMT(7)=DVBANXLN
  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.  ;CALL FUNCTION TO BUILD A 'TEXT TO DISPLAY' ARRAY OF CONSULTS
  1.  ;
  1.  D XMZ^XMA2
  1.  D ^XMD
  1.  ;
  1.  Q
  1.  ;
  1. GEMA(IEN) ;GET #200 NEW PERSON INFO - GET EMAIL ADDRESS
  1.  N DVBAERR,DVBAEMA
  1.  ;
  1.  ; IA# 10060
  1.  S DVBAEMA=$$GET1^DIQ(200,IEN,".151","I",,"DVBAERR")
  1.  I '$D(DVBAEMA) Q 0
  1.  Q DVBAEMA