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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAVRX1 10183 printed Nov 22, 2024@16:52:39 Page 2
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
+2 ;
+3 ;NO DIRECT ENTRY
QUIT
+4 ;
+5 ; RUN FROM TASK MANAGER (BACKGROUND BATCH JOB)
+6 ; BACKGROUND JOB SHOULD BE RUN ON SAME DAY AS DATA ENTRY AT THE END OF THE BUSINESS DAY
+7 ; CALL INDIVIDUAL TAGS FROM RPC (MAILMAN NOTIFY - REALTIME)
+8 ;
+9 ;FOR BUILD:
+10 ; MAILMAN GROUP -> "DVBA VR VOCREHAB PERSONNEL"
+11 ; OPTION FILE OPTION -> "DVBA VR BACKGROUND"
+12 ; RPC -> NEW REQUEST
+13 ; RPC -> CANCELLED REQUEST
+14 ; RPC -> COMPLETED REQUEST
+15 ; RPC -> PENDING REQUEST
+16 ;
EN ; TASKMAN ENTER POINT FOR BACKGROUND JOB
+1 ;
+2 ; For "N"ew status based on the INDEX - age entries and alert users of un-linked requests.
DO JOB1^DVBAVRX2
+3 ; LOOK AT STATUS OF FILE 123 --> 100.01 AND WORK MAIL NOTIFICATIONS
DO JOB2
+4 ;
+5 QUIT
+6 ;
JOB2 ;JOB 2 WILL LOOK AT STATUS OF CONSULTS LINKED TO 8861
+1 ; WHEN ALL CONSULTS AS CANCELLED - FORM 8861 WILL BE CANCELLED
+2 ; WHEN A CONSULT IS COMPLETED AND IS THE ONLY CONSULT LINKED TO THE FORM - FORM 8861 WILL BE COMPLETED
+3 ; WHEN A CONSULT IS COMPLETED AND ALL OTHER CONSULTS ARE COMPLETE OR CANCLLED - FORM 8861 WILL BE COMPLETED
+4 ;
+5 NEW %H,DAT,X,J
+6 NEW DVBADAT,DVBAIEN,DVBAIENX
+7 ;CONSULTS ARRAY
NEW DVBACARY
+8 ;CONSULTS GETS ERROR ARRAY
NEW DVBACERR
+9 ;IEN OF FORM 8831 CONTAINED IN THE CONSULTS ARRAY (TOP)
NEW DVBAIENT
+10 ;SEQUENCE NUMBER OF FORM 8861 MULTI CONTAINED IN THE CONSULTS ARRAY (MULTI SEQUENTIAL NUMBER)
NEW DVBAMLTN
+11 ;TEMP ARRAY 1 - CONSULTS MULTI
NEW DVBATMP1
+12 ;CONSULT/REQUEST STATUS --> 100.01,.001
NEW DVBARCST
+13 ;VOCREHAB STATUS OF MULTI (396.914,.02)
NEW DVBAVRST
+14 ;REVERSE THE IEN KEYS AGAIN
NEW DVBARKEY
+15 ;ARRAY FOR CANCELLED / COMPLETE LOGIC
NEW DVBACC
+16 ;UPDATE API ARRAY
NEW DVBAFDA
+17 ;TODAY'S DATE
NEW DVBATD
+18 NEW DVBACAN,DVBACOM
+19 ;
+20 SET DVBADAT=""
FOR
SET DVBADAT=$ORDER(^DVB(396.9,"ARSDT","P",DVBADAT))
if DVBADAT=""
QUIT
Begin DoDot:1
+21 SET DVBAIEN=""
FOR
SET DVBAIEN=$ORDER(^DVB(396.9,"ARSDT","P",DVBADAT,DVBAIEN))
if DVBAIEN=""
QUIT
Begin DoDot:2
+22 ;GET CONSULT INFO AND BUILD CONSULT ARRAY
+23 KILL DVBATMP1
+24 KILL DVBACARY
+25 DO GETS^DIQ(396.9,DVBAIEN,"14*","IE","DVBACARY","DVBACERR")
+26 SET J=""
FOR
SET J=$ORDER(DVBACARY(396.914,J))
if J=""
QUIT
Begin DoDot:3
+27 ;SHOULD ALWAYS BE THE SAME AS IEN
SET DVBAIENT=$PIECE(J,",",2)
+28 SET DVBAMLTN=$PIECE(J,",",1)
+29 ;BUILD TEMP ARRAY OF MULTI
+30 SET DVBATMP1(DVBAIENT,DVBAMLTN,.01,"I")=$GET(DVBACARY(396.914,J,.01,"I"))
+31 SET DVBATMP1(DVBAIENT,DVBAMLTN,.02,"I")=$GET(DVBACARY(396.914,J,.02,"I"))
End DoDot:3
+32 ;WORK TEMP ARRAY
+33 ;$P1 = VALUE FORM FORM ARRAY ^ $P2 = VALUE FROM CONSULTS -> STATUS #123; field 8 (internal value)
+34 SET DVBAIENT=""
+35 KILL DVBACC
+36 FOR
SET DVBAIENT=$ORDER(DVBATMP1(DVBAIENT))
if DVBAIENT=""
QUIT
Begin DoDot:3
+37 SET DVBAMLTN=""
+38 FOR
SET DVBAMLTN=$ORDER(DVBATMP1(DVBAIENT,DVBAMLTN))
if DVBAMLTN=""
QUIT
Begin DoDot:4
+39 SET DVBARKEY=DVBAMLTN_","_DVBAIENT
+40 SET DVBAVRST=$$GET1^DIQ(396.914,DVBARKEY,.02,"I")
+41 ;ICR #4110
+42 SET DVBAIENX=DVBATMP1(DVBAIENT,DVBAMLTN,.01,"I")
+43 ;IEN OF THE 123 FILE VR IS POINTING TO
SET DVBARCST=$$GET1^DIQ(123,DVBAIENX,8,"I")
+44 ;
+45 IF DVBARCST=1
SET DVBACC(DVBARCST)=""
+46 IF DVBARCST=2
SET DVBACC(DVBARCST)=""
+47 IF DVBARCST'=1&(DVBARCST'=2)
SET DVBACC(0)=""
+48 ;
+49 ;UPDATE VOCREHAB LAST STATUS
IF DVBARCST'=DVBAVRST
Begin DoDot:5
+50 KILL DVBAFDA
+51 SET DVBAFDA(1,396.914,DVBARKEY_",",.02)=DVBARCST
+52 ;IRC #875 - points to 100.01
+53 DO UPDATE^DIE("","DVBAFDA(1)","","DVBAUERR")
+54 IF $DATA(DVBAUERR)
QUIT
End DoDot:5
End DoDot:4
+55 ;COMPLETED SWITCH
SET DVBACOM=0
+56 ;CANCELLED SWITCH
SET DVBACAN=0
+57 ;multi logic, should it ever be needed
Begin DoDot:4
+58 IF $DATA(DVBACC(0))
QUIT
+59 IF $DATA(DVBACC(1))&($DATA(DVBACC(2)))
SET DVBACOM=1
QUIT
+60 IF $DATA(DVBACC(1))
SET DVBACAN=1
QUIT
+61 IF $DATA(DVBACC(2))
SET DVBACOM=1
QUIT
End DoDot:4
+62 IF DVBACAN=1
Begin DoDot:4
+63 KILL DVBAFDA,DVBAUERR
+64 SET DVBAFDA(1,396.9,DVBAIENT_",",13)="X"
+65 KILL %H,DAT,X
+66 ;CONVERT $H TO FILEMAN DATE
SET (%H,DAT)=+$HOROLOG
DO YMD^%DTC
+67 SET DVBAFDA(1,396.9,DVBAIENT_",",15)=X
+68 SET DVBAFDA(1,396.9,DVBAIENT_",",16)="OTH"
+69 DO UPDATE^DIE("","DVBAFDA(1)","","DVBAUERR")
+70 IF $DATA(DVBAUERR)
QUIT
+71 DO RPCIN(DVBAIEN,"CAN")
End DoDot:4
+72 IF DVBACOM=1
Begin DoDot:4
+73 KILL DVBAFDA,DVBAUERR
+74 SET DVBAFDA(1,396.9,DVBAIENT_",",13)="C"
+75 KILL %H,DAT,X
+76 ;CONVERT $H TO FILEMAN DATE
SET (%H,DAT)=+$HOROLOG
DO YMD^%DTC
+77 SET DVBAFDA(1,396.9,DVBAIENT_",",2)=X
+78 DO UPDATE^DIE("","DVBAFDA(1)","","DVBAUERR")
+79 IF $DATA(DVBAUERR)
QUIT
+80 DO RPCIN(DVBAIEN,"COM")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+81 ;
+82 QUIT
+83 ;
RPCIN(DVBAFIEN,DVBATYPE) ;ENTER (IN) POINT FOR RPC CALLS
+1 ;
+2 ;Parameters Passed In
+3 ;DVBAFIEN The IEN of the 8861 Form
+4 ;DVBATYPE The type of the mailman message to be sent
+5 ; 'NEW'
+6 ; 'PENDING'
+7 ; 'CANCELLED'
+8 ;
+9 NEW XMDUZ,DVBADUZ
+10 ;
+11 IF '$DATA(DUZ)
QUIT
+12 ;
+13 SET XMDUZ=$PIECE(^VA(200,DUZ,0),"^",1)_" CAPRI"
+14 SET DVBADUZ=DUZ
+15 ;
+16 IF DVBATYPE="NEW"
DO NFY(DVBAFIEN,"NEW")
QUIT
+17 IF DVBATYPE="PND"
DO NFY(DVBAFIEN,"PND")
QUIT
+18 IF DVBATYPE="COM"
DO NFY(DVBAFIEN,"COM")
QUIT
+19 IF DVBATYPE="CAN"
DO NFY(DVBAFIEN,"CAN")
QUIT
+20 ;
+21 QUIT
+22 ;
NFY(DVBAFIEN,DVBATYPE) ;SETUP MAILMAN MESSAGE BASED ON REQUEST FORM IEN
+1 ;D GETS^DIQ TO POPULATE REQUEST INFO
+2 ;
+3 NEW Y,%H,%
+4 NEW XMSUB,XMTEXT,XMY,XMDUN,XMZ,XMMG
+5 NEW DVBAFARY,DVBAFERR,DVBASTT,DVBAVRRA,DVBAGERR
+6 NEW DVBAPOC,DVBARDAT,DVBAPDFN,DVBAPNAM,DVBARSTT,DVBASNTL,DVBAXIEN
+7 NEW DVBAMMT,DVBAEMA
+8 NEW DVBANXLN,DVBAXXEN
+9 NEW C,D,D0,DA,DI,DIC,DIE,DILOCKTM,DISYS,DQ,DR,X
+10 ;
+11 NEW DUZ
+12 ;POSTMASTER
SET DUZ=.5
+13 ;SINCE MAILMAN DOES NOT ALLOW MESSAGES TO BE SENT FROM USERS WITHOUT ACCESS CODES OR MAILBOXES
+14 ;WHICH CAPRI REMOTE USER DO NOT HAVE, WE HAVE TO NEW DUZ AND CHANGE XMDUZ TO THE NAME OF THE USER
+15 ;AS A STRING SO THE PROCESS IS STILL LINKED TO THE USER SENDING/TRIGGERING THE MESSAGE
+16 ;
+17 DO GETS^DIQ(396.9,DVBAFIEN,"*","IE","DVBAFARY","DVBAFERR")
+18 IF $DATA(DVBAFERR)
QUIT
+19 ;
+20 SET DVBAPOC=$GET(DVBAFARY(396.9,DVBAFIEN_",",11,"I"))
+21 SET DVBARDAT=$GET(DVBAFARY(396.9,DVBAFIEN_",",.01,"E"))
+22 SET DVBAPDFN=$GET(DVBAFARY(396.9,DVBAFIEN_",",4,"I"))
+23 SET DVBARSTT=$GET(DVBAFARY(396.9,DVBAFIEN_",",13,"E"))
+24 SET DVBASNTL=$GET(DVBAFARY(396.9,DVBAFIEN_",",1,"E"))
+25 ;
+26 SET %H=$HOROLOG
DO YX^%DTC
SET X=X_%
SET DVBASTT=$$FMTE^XLFDT(X,"5FPZ")
+27 SET XMSUB="CAPRI: Chapter 31 Referral for Medical Services New"
+28 ;
+29 SET XMY("G.DVBA VR VOCREHAB PERSONNEL")=""
+30 SET DVBAEMA="DVBA VR VOCREHAB PERSONNEL"
+31 ;
+32 IF DVBATYPE="NEW"
DO XNEW
+33 IF DVBATYPE="PND"
DO XPND
+34 IF DVBATYPE="COM"
DO XCOM
+35 IF DVBATYPE="CAN"
DO XCAN
+36 ;
+37 if DVBATYPE="NEW"
QUIT
+38 ;
+39 KILL XMY
+40 ;
+41 SET DVBAXXEN=DVBAFARY(396.9,DVBAFIEN_",",11,"I")
+42 SET DVBAVRRA=$$GET1^DIQ(200,DVBAXXEN,.151,"","","DVBAGERR")
+43 IF $DATA(DVBAGERR)
QUIT
+44 SET DVBAEMA=DVBAVRRA
+45 IF DVBAEMA=""
QUIT
+46 SET XMY(DVBAEMA)=""
+47 ;
+48 IF DVBATYPE="PND"
DO XPND
+49 IF DVBATYPE="COM"
DO XCOM
+50 IF DVBATYPE="CAN"
DO XCAN
+51 ;
+52 QUIT
+53 ;
XNEW ;
+1 ;
+2 SET XMSUB="CAPRI: Chapter 31 Referral for Medical Services New"
+3 SET XMTEXT="DVBAMMT("
+4 SET DVBAMMT(1)="Sent: "_DVBASTT
+5 SET DVBAMMT(2)="To: "_DVBAEMA
+6 SET DVBAMMT(3)="Subject: "_XMSUB
+7 SET DVBAMMT(4)=""
+8 SET DVBAMMT(5)="The following veteran has a New Chapter 31, FORM 28-8861"
+9 SET DVBAMMT(6)=""
+10 SET DVBANXLN=""
+11 SET DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$EXTRACT(" ",1,12-$LENGTH(DVBAPDFN))_" "
+12 SET DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT
+13 SET DVBAMMT(7)=DVBANXLN
+14 SET DVBAMMT(10)=""
+15 SET DVBAMMT(11)="**NOTE: To view the patient using the DFN, paste the DFN number into the"
+16 SET DVBAMMT(12)="CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to"
+17 SET DVBAMMT(13)="include the ' (backward-apostrophe) character."
+18 ;
+19 DO XMZ^XMA2
+20 DO ^XMD
+21 ;
+22 QUIT
+23 ;
XCOM ;
+1 ;
+2 SET XMSUB="CAPRI: Chapter 31 Referral for Medical Services Completed"
+3 SET XMTEXT="DVBAMMT("
+4 SET DVBAMMT(1)="Sent: "_DVBASTT
+5 SET DVBAMMT(2)="To: "_DVBAEMA
+6 SET DVBAMMT(3)="Subject: "_XMSUB
+7 SET DVBAMMT(4)=""
+8 SET DVBAMMT(5)="The following veteran has a Completed Chapter 31, FORM 28-8861"
+9 SET DVBAMMT(6)=""
+10 SET DVBANXLN=""
+11 SET DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$EXTRACT(" ",1,12-$LENGTH(DVBAPDFN))_" "
+12 SET DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT
+13 SET DVBAMMT(7)=DVBANXLN
+14 SET DVBAMMT(10)=""
+15 SET DVBAMMT(11)="**NOTE: To view the patient using the DFN, paste the DFN number into the"
+16 SET DVBAMMT(12)="CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to"
+17 SET DVBAMMT(13)="include the ' (backward-apostrophe) character."
+18 ;
+19 ;CALL FUNCTION TO BUILD A 'TEXT TO DISPLAY' ARRAY OF CONSULTS
+20 ;
+21 DO XMZ^XMA2
+22 DO ^XMD
+23 ;
+24 QUIT
+25 ;
XCAN ;
+1 ;
+2 SET XMSUB="CAPRI: Chapter 31 Referral for Medical Services Cancelled"
+3 SET XMTEXT="DVBAMMT("
+4 SET DVBAMMT(1)="Sent: "_DVBASTT
+5 SET DVBAMMT(2)="To: "_DVBAEMA
+6 SET DVBAMMT(3)="Subject: "_XMSUB
+7 SET DVBAMMT(4)=""
+8 SET DVBAMMT(5)="The following veteran has a Cancelled Chapter 31, FORM 28-8861"
+9 SET DVBAMMT(6)=""
+10 SET DVBANXLN=""
+11 SET DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$EXTRACT(" ",1,12-$LENGTH(DVBAPDFN))_" "
+12 SET DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT
+13 SET DVBAMMT(7)=DVBANXLN
+14 SET DVBAMMT(10)=""
+15 SET DVBAMMT(11)="**NOTE: To view the patient using the DFN, paste the DFN number into the"
+16 SET DVBAMMT(12)="CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to"
+17 SET DVBAMMT(13)="include the ' (backward-apostrophe) character."
+18 ;CALL FUNCTION TO BUILD A 'TEXT TO DISPLAY' ARRAY OF CONSULTS
+19 ;
+20 DO XMZ^XMA2
+21 DO ^XMD
+22 ;
+23 QUIT
+24 ;
XPND ;
+1 ;
+2 SET XMSUB="CAPRI: Chapter 31 Referral for Medical Services Pending"
+3 SET XMTEXT="DVBAMMT("
+4 SET DVBAMMT(1)="Sent: "_DVBASTT
+5 SET DVBAMMT(2)="To: "_DVBAEMA
+6 SET DVBAMMT(3)="Subject: "_XMSUB
+7 SET DVBAMMT(4)=""
+8 SET DVBAMMT(5)="The following veteran has a Pending Chapter 31, FORM 28-8861"
+9 SET DVBAMMT(6)=""
+10 SET DVBANXLN=""
+11 SET DVBANXLN=DVBANXLN_"DFN: `"_DVBAPDFN_$EXTRACT(" ",1,12-$LENGTH(DVBAPDFN))_" "
+12 SET DVBANXLN=DVBANXLN_"Request Date: "_DVBARDAT
+13 SET DVBAMMT(7)=DVBANXLN
+14 SET DVBAMMT(10)=""
+15 SET DVBAMMT(11)="**NOTE: To view the patient using the DFN, paste the DFN number into the"
+16 SET DVBAMMT(12)="CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to"
+17 SET DVBAMMT(13)="include the ' (backward-apostrophe) character."
+18 ;CALL FUNCTION TO BUILD A 'TEXT TO DISPLAY' ARRAY OF CONSULTS
+19 ;
+20 DO XMZ^XMA2
+21 DO ^XMD
+22 ;
+23 QUIT
+24 ;
GEMA(IEN) ;GET #200 NEW PERSON INFO - GET EMAIL ADDRESS
+1 NEW DVBAERR,DVBAEMA
+2 ;
+3 ; IA# 10060
+4 SET DVBAEMA=$$GET1^DIQ(200,IEN,".151","I",,"DVBAERR")
+5 IF '$DATA(DVBAEMA)
QUIT 0
+6 QUIT DVBAEMA
