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