source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCXMS.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.2 KB
Line 
1RCRCXMS ;ALB/CMS - RC TRANSMISSION MESSAGE HANDLER ; 16-JUN-00
2V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6ENT(RCDA,RCSUB,RCWHO,RCCOM) ;RC Transmission information
7 ;add RC TRANSMISSION TO FILE 349.3
8 N DA,DIC,DIE,DLAYGO,DR,RCPDT,RCSND,X,Y
9 K DD,DO
10 I 'RCDA G ENTQ
11 S RCD=$O(^RCT(349.3,"B",RCDA,0)) I RCD G ENTE
12 S X=RCDA,DIC="^RCT(349.3,",DIC(0)="L",DLAYGO=349.3
13 D FILE^DICN S RCD=+Y K DD,DO I RCD<1 G ENTQ
14ENTE S DA=RCD S DIE="^RCT(349.3,"
15 S RCSND=$E($P($G(^VA(200,+DUZ,0)),U,1),1,45)
16 S RCSND=$S(RCSND]"":RCSND,1:"POSTMASTER")
17 D PURG
18 ;if entry is from RC via the RC Server
19 I $G(RCSCE)="O" S RCSND=$G(XMFROM)
20 S DR="1////"_$E(RCSUB,1,45)_";2////"_RCSND_";4////"_DT
21 S DR=DR_";8////"_+$G(RCPDT)_";3////"_$E(RCWHO,1,45)_";7///"_$G(RCCOM)
22 D ^DIE
23 S RCCOM="Transmitted to RC in MM #["_RCDA_"] containing "_+$G(RCCNT)_" bill(s)."
24ENTQ Q
25 ;
26PURG ;Get Purge Date
27 N X1
28 S X1=$O(^RCT(349.1,"B","RC",0))
29 I 'X1 G PURGQ
30 S X1=+$P(^RCT(349.1,X1,0),U,4)
31 S RCPDT=$$FMADD^XLFDT(DT,$S($G(X1):X1,1:30))
32PURGQ Q
33 ;
34SITE ;RC Site Parameter Edit
35 N D1,DA,DIC,DIE,DIK,DTOUT,DR,RCDA,RCSITE,X,Y
36 S (RCDA,DA)=$O(^RCT(349.1,"B","RC",0)),DIE="^RCT(349.1,"
37 S RCSITE=$P($$SITE^RCMSITE,U,2)
38 I 'DA G SITEQ
39 ;S DR=".04;W !!,""Primary Division: "",$P($G(^DIC(4,$$SITE^RCMSITE,0)),U,1);32R~PRIMARY RC REMOTE DOMAIN"_";I $E($G(^DIC(4.2,X,0)),1,3)'=""RC-"" W !,"" <<RC DOMAIN MUST START WITH 'RC-'>>"" S Y=32" D ^DIE
40 S DR=".04;W !!,""Primary Division: "",$P($G(^DIC(4,$$SITE^RCMSITE,0)),U,1);34R~RC MAIL ADDRESS"_";I $E($G(X),1,3)'=""OGC""!($E($G(X),7,20)'=""RI@MAIL.VA.GOV"") D MAILADD^RCRCXMS S Y=34"
41 S DR=DR_";35R~RC DEATH NOTIFICATION ADDRESS"_";I $E($G(X),1,9)'=""OGCRegion"" D DEATHADD^RCRCXMS S Y=35" D ^DIE
42 I ($D(DTOUT))!($D(Y)) G SITEQ
43 ;
44DR61 W !!,"Enter Division(s) of care if domain is different then primary RC Mail Address.",!
45 S DR=61
46 ;S DR(2,349.161)=".01;.02R~RC MAIL ADDRESS"_";I $E($G(^DIC(4.2,X,0)),1,3)'=""RC-"" W !,"" <<RC DOMAIN MUST START WITH 'RC-'>>"" S Y=.02" D ^DIE
47 S DR(2,349.161)=".01;.03R~RC MAIL ADDRESS"_";I $E($G(X),1,3)'=""OGC""!($E($G(X),7,20)'=""RI@MAIL.VA.GOV"") D MAILADD^RCRCXMS S Y=.03"_";N RCFLAG D DIK^RCRCXMS I $G(RCFLAG) S Y=.01"
48 S DR(2,349.161)=DR(2,349.161)_";.04R~RC DEATH NOTIFICATION ADDRESS"_";I $E($G(X),1,9)'=""OGCRegion"" D DEATHADD^RCRCXMS S Y=.04" D ^DIE
49 ;S DR(2,349.161)=".04R~RC DEATH NOTIFICATION ADDRESS"_";I $E($G(X),1,3)'=""OGC""!($E($G(X),7,20)'=""RI@MAIL.VA.GOV"") D DEATHADD^RCRCXMS S Y=.04" D ^DIE
50 ;
51SITEQ Q
52 ;
53DIK ;If the RC address is the same as the primary,the entry will be deleted.
54 I X=$P($G(^RCT(349.1,RCDA,3)),U,4) W !!,"<< DELETING ENTRY. Domain same as Primary RC Remote Domain.>>",!! D
55 .S DA(1)=RCDA,DIK="^RCT(349.1,"_RCDA_",6,",DA=D1 D ^DIK
56 .S RCFLAG=1
57 .Q
58 Q
59MAILADD ;MAIL ADDRESS FOR REGIONAL COUNSEL
60 W !!,"Please enter an Regional Counsel mail address that adheres to the"
61 W !,"following format:"
62 W !!," The first three characters must be 'OGC'"
63 W !," Characters 7 through 20 should be 'RI@MAIL.VA.GOV'"
64 W !!,"Choose one of the following RC addresses:",!
65 N RCCT,RCMAIL,RCUP
66 F RCCT=1:1 S RCMAIL=$P($T(ADDR+RCCT),";;",2) Q:RCMAIL="END"!(+$G(RCUP)) D
67 .I RCCT=15 R !,"""^"" TO QUIT: ",X:DTIME S:X="^" RCUP=1 Q:X="^" W $C(13),$J("",15),$C(13)
68 .W !,$P(RCMAIL,"^",1)
69 .Q
70 Q
71DEATHADD ;DEATH ADDRESSES FOR REGIONAL COUNSEL
72 W !!,"Please enter the Death Notification mail address adhering to"
73 W !,"the following format:"
74 W !!," The first nine characters must be 'OGCRegion'"
75 W !," followed by a number from 1-23"
76 W !," followed by 'DeathNotification@mail.va.gov'"
77 W !!," Choose from one of the following:",!
78 N RCCT,RCMAIL,RCUP
79 F RCCT=1:1 S RCMAIL=$P($T(ADDR+RCCT),";;",2) Q:RCMAIL="END"!(+$G(RCUP)) D
80 .I RCCT=15 R !,"""^"" TO QUIT: ",X:DTIME S:X="^" RCUP=1 Q:X="^" W $C(13),$J("",15),$C(13)
81 .W !,$P(RCMAIL,"^",2)
82 .Q
83 Q
84ADDR ;
85 ;;OGCBOSRI@MAIL.VA.GOV^OGCRegion1DeathNotification@mail.va.gov
86 ;;OGCNYNRI@MAIL.VA.GOV^OGCRegion2DeathNotification@mail.va.gov
87 ;;OGCBALRI@MAIL.VA.GOV^OGCRegion3DeathNotification@mail.va.gov
88 ;;OGCPHIRI@MAIL.VA.GOV^OGCRegion4DeathNotification@mail.va.gov
89 ;;OGCATLRI@MAIL.VA.GOV^OGCRegion5DeathNotification@mail.va.gov
90 ;;OGCBAYRI@MAIL.VA.GOV^OGCRegion6DeathNotification@mail.va.gov
91 ;;OGCCLERI@MAIL.VA.GOV^OGCRegion7DeathNotification@mail.va.gov
92 ;;OGCNASRI@MAIL.VA.GOV^OGCRegion8DeathNotification@mail.va.gov
93 ;;OGCJACRI@MAIL.VA.GOV^OGCRegion9DeathNotification@mail.va.gov
94 ;;OGCCHIRI@MAIL.VA.GOV^OGCRegion10DeathNotification@mail.va.gov
95 ;;OGCDETRI@MAIL.VA.GOV^OGCRegion11DeathNotification@mail.va.gov
96 ;;OGCSTLRI@MAIL.VA.GOV^OGCRegion12DeathNotification@mail.va.gov
97 ;;OGCWACRI@MAIL.VA.GOV^OGCRegion13DeathNotification@mail.va.gov
98 ;;OGCHOURI@MAIL.VA.GOV^OGCRegion14DeathNotification@mail.va.gov
99 ;;OGCMINRI@MAIL.VA.GOV^OGCRegion15DeathNotification@mail.va.gov
100 ;;OGCDENRI@MAIL.VA.GOV^OGCRegion16DeathNotification@mail.va.gov
101 ;;OGCLOSRI@MAIL.VA.GOV^OGCRegion17DeathNotification@mail.va.gov
102 ;;OGCSFCRI@MAIL.VA.GOV^OGCRegion18DeathNotification@mail.va.gov
103 ;;OGCPHORI@MAIL.VA.GOV^OGCRegion19DeathNotification@mail.va.gov
104 ;;OGCPORRI@MAIL.VA.GOV^OGCRegion20DeathNotification@mail.va.gov
105 ;;OGCBUFRI@MAIL.VA.GOV^OGCRegion21DeathNotification@mail.va.gov
106 ;;OGCINDRI@MAIL.VA.GOV^OGCRegion22DeathNotification@mail.va.gov
107 ;;OGCWINRI@MAIL.VA.GOV^OGCRegion23DeathNotification@mail.va.gov
108 ;;END
109EN(RCTAG) ;
110 ;ENTRY POINT FROM RC TRANSMISSIONS LIST TEMPLATE
111 N DA,DIC,DIQ,DIR,DR,RC,RCCNT,RCY,RCDA,RCOUT,RCT,RCTE,X,Y
112 D FULL^VALM1
113 I '$O(^RCT(349.3,0)) W !!," ** TRANSMISSION LOG EMPTY **" G ENQ
114 I '$O(^TMP("RCRCE",$J,"SEL",0)) W !!," ** NO ITEMS SELECTED FROM LIST **" G ENQ
115 D @$S(RCTAG="COM":"COM",RCTAG="DEL":"DEL",RCTAG="VEW":"VEW",RCTAG="FRW":"VEW",1:"ENQ")
116ENQ K DIR D:$G(RCOUT)'["^" PAUSE^VALM1 Q
117 ;
118COM ;Append Comments to File 349.3
119 N DA,DR,DIC,DIE,DIR,DIROUT,DUOUT,RCX,RCY,X,Y S RCOUT=""
120 ;S DIC="^RCT(349.3,",DWLW=75,DIWEPSE="" D EN^DIWE
121 ;Enter Comments for each or all?
122 S RCX=0 F S RCX=$O(^TMP("RCRCE",$J,"SEL",RCX)) Q:('RCX)!(RCOUT["^") D
123 .S DA=$G(^TMP("RCRCEX",$J,RCX)),RCLN=+DA,DA=$P(DA,U,2)
124 .I '$D(^RCT(349.3,DA,0)) W !,"Item ",RCX,". Transmission Entry no longer exists.",!!
125 .I $D(^RCT(349.3,DA,0)) D
126 ..W @IOF,!!,"Item ",RCX,"." S (DIC,DIE)="^RCT(349.3," D EN^DIQ W ! S DR="7" D ^DIE K DR
127 .W ! S DIR(0)="E" D ^DIR K DIR I $D(DIROUT)!$D(DUOUT) S RCOUT="^" Q
128 .W @IOF
129 S RCOUT="" W !!,"REMEMBER: Resequence List to see Appended Comments.",!
130COMQ Q
131 ;
132DEL ;Delete entries in File 349.3
133 N DA,DIK,DIR,RCLN,RCX,RCY,X,Y
134 S RCY="...deleted... "
135 W @IOF W !,"Selected Items ..."
136 S RCX=0 F S RCX=$O(^TMP("RCRCE",$J,"SEL",RCX)) Q:'RCX D
137 .S RCLN=+$G(^TMP("RCRCEX",$J,RCX))
138 .W !,$G(^TMP("RCRCE",$J,RCLN,0))
139 W !!!,?8,"ALL ITEMS SELECTED WILL BE DELETED FROM"
140 W !,?5,"TRANSMISSION LOG FILE WITHOUT FURTHER WARNING!",!!
141 S DIR("A")="Okay to Continue Deletion(s) ",DIR("?")="Enter Yes to Continue with deletions"
142 D ASK^RCRCACP K DIR I $G(Y)'=1 W !,"Okay nothing deleted." G DELQ
143 W !!,"Deleting ..."
144 S RCX=0 F S RCX=$O(^TMP("RCRCE",$J,"SEL",RCX)) Q:'RCX D
145 .S DA=$G(^TMP("RCRCEX",$J,RCX)),RCLN=+DA,DA=$P(DA,U,2)
146 .I $D(^RCT(349.3,DA,0)) D
147 ..S DIK="^RCT(349.3," D ^DIK
148 ..W !,$G(^TMP("RCRCE",$J,RCLN,0))
149 ..D FLDTEXT^VALM10(RCLN,"SUBJECT",RCY)
150 S RCOUT="" W !!,"REMEMBER: Resequence List to remove Deleted Items from list.",!
151DELQ Q
152 ;
153VEW ;View/Forward XM Message
154 N DA,DIR,DIROUT,DUOUT,RCLN,RCX,X,Y
155 S RCOUT="",RCX=0 F S RCX=$O(^TMP("RCRCE",$J,"SEL",RCX)) Q:('RCX)!(RCOUT["^") D
156 .S DA=$G(^TMP("RCRCEX",$J,RCX)),RCLN=+DA,DA=$P(DA,U,2)
157 .I '$D(^RCT(349.3,+DA,0)) W !!,"Item ",RCX,".",?5," Transmission Entry no longer exists.",!!
158 .I $D(^RCT(349.3,+DA,0)) D VEWD I RCOUT="^" Q
159 .W ! S DIR(0)="E" D ^DIR I $D(DIROUT)!$D(DUOUT) S RCOUT="^" Q
160 .W @IOF
161VEWQ Q
162VEWD ;Display message
163 N DIR,DIROUT,DUOUT,RCI,RCY,X,XMER,XMPOS,XMRG,XMZ,X,Y W @IOF
164 S RCI=$G(^RCT(349.3,+DA,0)),XMZ=+RCI
165 S RCY=$$NET^XMRENT(XMZ)
166 I RCY="" W !!,RCX,".",?5," Mail Message #["_XMZ_"] no longer exists on this system.",! S XMZ=0 G VEWDQ
167 W !,RCX,"."
168 W !,"Subj: "_$P(RCY,U,6)_" [#"_XMZ_"] "_$P(RCY,U,1)
169 W !,"From: "_$P(RCY,U,3)
170 W !,"Message ID: "_$P(RCY,U,4)
171 W !,"Recipient: "_$P(RCI,U,4)
172 W !! F X=1:1:(IOM-1) W "="
173 W !
174 F W !,$$READ^XMGAPI1() Q:(XMER=-1)!(RCOUT="^") I ($Y+3)>IOSL D
175 .W ! S DIR(0)="E" D ^DIR I $D(DIROUT)!$D(DUOUT) S RCOUT="^" Q
176 .W @IOF
177 I RCTAG="FRW" W !! I XMZ D ENT2^XMD
178VEWDQ Q
179 ;
180 ;RCRCXMS
Note: See TracBrowser for help on using the repository browser.