181 lines
8.2 KiB
Mathematica
181 lines
8.2 KiB
Mathematica
RCRCXMS ;ALB/CMS - RC TRANSMISSION MESSAGE HANDLER ; 16-JUN-00
|
|
V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
ENT(RCDA,RCSUB,RCWHO,RCCOM) ;RC Transmission information
|
|
;add RC TRANSMISSION TO FILE 349.3
|
|
N DA,DIC,DIE,DLAYGO,DR,RCPDT,RCSND,X,Y
|
|
K DD,DO
|
|
I 'RCDA G ENTQ
|
|
S RCD=$O(^RCT(349.3,"B",RCDA,0)) I RCD G ENTE
|
|
S X=RCDA,DIC="^RCT(349.3,",DIC(0)="L",DLAYGO=349.3
|
|
D FILE^DICN S RCD=+Y K DD,DO I RCD<1 G ENTQ
|
|
ENTE S DA=RCD S DIE="^RCT(349.3,"
|
|
S RCSND=$E($P($G(^VA(200,+DUZ,0)),U,1),1,45)
|
|
S RCSND=$S(RCSND]"":RCSND,1:"POSTMASTER")
|
|
D PURG
|
|
;if entry is from RC via the RC Server
|
|
I $G(RCSCE)="O" S RCSND=$G(XMFROM)
|
|
S DR="1////"_$E(RCSUB,1,45)_";2////"_RCSND_";4////"_DT
|
|
S DR=DR_";8////"_+$G(RCPDT)_";3////"_$E(RCWHO,1,45)_";7///"_$G(RCCOM)
|
|
D ^DIE
|
|
S RCCOM="Transmitted to RC in MM #["_RCDA_"] containing "_+$G(RCCNT)_" bill(s)."
|
|
ENTQ Q
|
|
;
|
|
PURG ;Get Purge Date
|
|
N X1
|
|
S X1=$O(^RCT(349.1,"B","RC",0))
|
|
I 'X1 G PURGQ
|
|
S X1=+$P(^RCT(349.1,X1,0),U,4)
|
|
S RCPDT=$$FMADD^XLFDT(DT,$S($G(X1):X1,1:30))
|
|
PURGQ Q
|
|
;
|
|
SITE ;RC Site Parameter Edit
|
|
N D1,DA,DIC,DIE,DIK,DTOUT,DR,RCDA,RCSITE,X,Y
|
|
S (RCDA,DA)=$O(^RCT(349.1,"B","RC",0)),DIE="^RCT(349.1,"
|
|
S RCSITE=$P($$SITE^RCMSITE,U,2)
|
|
I 'DA G SITEQ
|
|
;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
|
|
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"
|
|
S DR=DR_";35R~RC DEATH NOTIFICATION ADDRESS"_";I $E($G(X),1,9)'=""OGCRegion"" D DEATHADD^RCRCXMS S Y=35" D ^DIE
|
|
I ($D(DTOUT))!($D(Y)) G SITEQ
|
|
;
|
|
DR61 W !!,"Enter Division(s) of care if domain is different then primary RC Mail Address.",!
|
|
S DR=61
|
|
;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
|
|
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"
|
|
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
|
|
;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
|
|
;
|
|
SITEQ Q
|
|
;
|
|
DIK ;If the RC address is the same as the primary,the entry will be deleted.
|
|
I X=$P($G(^RCT(349.1,RCDA,3)),U,4) W !!,"<< DELETING ENTRY. Domain same as Primary RC Remote Domain.>>",!! D
|
|
.S DA(1)=RCDA,DIK="^RCT(349.1,"_RCDA_",6,",DA=D1 D ^DIK
|
|
.S RCFLAG=1
|
|
.Q
|
|
Q
|
|
MAILADD ;MAIL ADDRESS FOR REGIONAL COUNSEL
|
|
W !!,"Please enter an Regional Counsel mail address that adheres to the"
|
|
W !,"following format:"
|
|
W !!," The first three characters must be 'OGC'"
|
|
W !," Characters 7 through 20 should be 'RI@MAIL.VA.GOV'"
|
|
W !!,"Choose one of the following RC addresses:",!
|
|
N RCCT,RCMAIL,RCUP
|
|
F RCCT=1:1 S RCMAIL=$P($T(ADDR+RCCT),";;",2) Q:RCMAIL="END"!(+$G(RCUP)) D
|
|
.I RCCT=15 R !,"""^"" TO QUIT: ",X:DTIME S:X="^" RCUP=1 Q:X="^" W $C(13),$J("",15),$C(13)
|
|
.W !,$P(RCMAIL,"^",1)
|
|
.Q
|
|
Q
|
|
DEATHADD ;DEATH ADDRESSES FOR REGIONAL COUNSEL
|
|
W !!,"Please enter the Death Notification mail address adhering to"
|
|
W !,"the following format:"
|
|
W !!," The first nine characters must be 'OGCRegion'"
|
|
W !," followed by a number from 1-23"
|
|
W !," followed by 'DeathNotification@mail.va.gov'"
|
|
W !!," Choose from one of the following:",!
|
|
N RCCT,RCMAIL,RCUP
|
|
F RCCT=1:1 S RCMAIL=$P($T(ADDR+RCCT),";;",2) Q:RCMAIL="END"!(+$G(RCUP)) D
|
|
.I RCCT=15 R !,"""^"" TO QUIT: ",X:DTIME S:X="^" RCUP=1 Q:X="^" W $C(13),$J("",15),$C(13)
|
|
.W !,$P(RCMAIL,"^",2)
|
|
.Q
|
|
Q
|
|
ADDR ;
|
|
;;OGCBOSRI@MAIL.VA.GOV^OGCRegion1DeathNotification@mail.va.gov
|
|
;;OGCNYNRI@MAIL.VA.GOV^OGCRegion2DeathNotification@mail.va.gov
|
|
;;OGCBALRI@MAIL.VA.GOV^OGCRegion3DeathNotification@mail.va.gov
|
|
;;OGCPHIRI@MAIL.VA.GOV^OGCRegion4DeathNotification@mail.va.gov
|
|
;;OGCATLRI@MAIL.VA.GOV^OGCRegion5DeathNotification@mail.va.gov
|
|
;;OGCBAYRI@MAIL.VA.GOV^OGCRegion6DeathNotification@mail.va.gov
|
|
;;OGCCLERI@MAIL.VA.GOV^OGCRegion7DeathNotification@mail.va.gov
|
|
;;OGCNASRI@MAIL.VA.GOV^OGCRegion8DeathNotification@mail.va.gov
|
|
;;OGCJACRI@MAIL.VA.GOV^OGCRegion9DeathNotification@mail.va.gov
|
|
;;OGCCHIRI@MAIL.VA.GOV^OGCRegion10DeathNotification@mail.va.gov
|
|
;;OGCDETRI@MAIL.VA.GOV^OGCRegion11DeathNotification@mail.va.gov
|
|
;;OGCSTLRI@MAIL.VA.GOV^OGCRegion12DeathNotification@mail.va.gov
|
|
;;OGCWACRI@MAIL.VA.GOV^OGCRegion13DeathNotification@mail.va.gov
|
|
;;OGCHOURI@MAIL.VA.GOV^OGCRegion14DeathNotification@mail.va.gov
|
|
;;OGCMINRI@MAIL.VA.GOV^OGCRegion15DeathNotification@mail.va.gov
|
|
;;OGCDENRI@MAIL.VA.GOV^OGCRegion16DeathNotification@mail.va.gov
|
|
;;OGCLOSRI@MAIL.VA.GOV^OGCRegion17DeathNotification@mail.va.gov
|
|
;;OGCSFCRI@MAIL.VA.GOV^OGCRegion18DeathNotification@mail.va.gov
|
|
;;OGCPHORI@MAIL.VA.GOV^OGCRegion19DeathNotification@mail.va.gov
|
|
;;OGCPORRI@MAIL.VA.GOV^OGCRegion20DeathNotification@mail.va.gov
|
|
;;OGCBUFRI@MAIL.VA.GOV^OGCRegion21DeathNotification@mail.va.gov
|
|
;;OGCINDRI@MAIL.VA.GOV^OGCRegion22DeathNotification@mail.va.gov
|
|
;;OGCWINRI@MAIL.VA.GOV^OGCRegion23DeathNotification@mail.va.gov
|
|
;;END
|
|
EN(RCTAG) ;
|
|
;ENTRY POINT FROM RC TRANSMISSIONS LIST TEMPLATE
|
|
N DA,DIC,DIQ,DIR,DR,RC,RCCNT,RCY,RCDA,RCOUT,RCT,RCTE,X,Y
|
|
D FULL^VALM1
|
|
I '$O(^RCT(349.3,0)) W !!," ** TRANSMISSION LOG EMPTY **" G ENQ
|
|
I '$O(^TMP("RCRCE",$J,"SEL",0)) W !!," ** NO ITEMS SELECTED FROM LIST **" G ENQ
|
|
D @$S(RCTAG="COM":"COM",RCTAG="DEL":"DEL",RCTAG="VEW":"VEW",RCTAG="FRW":"VEW",1:"ENQ")
|
|
ENQ K DIR D:$G(RCOUT)'["^" PAUSE^VALM1 Q
|
|
;
|
|
COM ;Append Comments to File 349.3
|
|
N DA,DR,DIC,DIE,DIR,DIROUT,DUOUT,RCX,RCY,X,Y S RCOUT=""
|
|
;S DIC="^RCT(349.3,",DWLW=75,DIWEPSE="" D EN^DIWE
|
|
;Enter Comments for each or all?
|
|
S RCX=0 F S RCX=$O(^TMP("RCRCE",$J,"SEL",RCX)) Q:('RCX)!(RCOUT["^") D
|
|
.S DA=$G(^TMP("RCRCEX",$J,RCX)),RCLN=+DA,DA=$P(DA,U,2)
|
|
.I '$D(^RCT(349.3,DA,0)) W !,"Item ",RCX,". Transmission Entry no longer exists.",!!
|
|
.I $D(^RCT(349.3,DA,0)) D
|
|
..W @IOF,!!,"Item ",RCX,"." S (DIC,DIE)="^RCT(349.3," D EN^DIQ W ! S DR="7" D ^DIE K DR
|
|
.W ! S DIR(0)="E" D ^DIR K DIR I $D(DIROUT)!$D(DUOUT) S RCOUT="^" Q
|
|
.W @IOF
|
|
S RCOUT="" W !!,"REMEMBER: Resequence List to see Appended Comments.",!
|
|
COMQ Q
|
|
;
|
|
DEL ;Delete entries in File 349.3
|
|
N DA,DIK,DIR,RCLN,RCX,RCY,X,Y
|
|
S RCY="...deleted... "
|
|
W @IOF W !,"Selected Items ..."
|
|
S RCX=0 F S RCX=$O(^TMP("RCRCE",$J,"SEL",RCX)) Q:'RCX D
|
|
.S RCLN=+$G(^TMP("RCRCEX",$J,RCX))
|
|
.W !,$G(^TMP("RCRCE",$J,RCLN,0))
|
|
W !!!,?8,"ALL ITEMS SELECTED WILL BE DELETED FROM"
|
|
W !,?5,"TRANSMISSION LOG FILE WITHOUT FURTHER WARNING!",!!
|
|
S DIR("A")="Okay to Continue Deletion(s) ",DIR("?")="Enter Yes to Continue with deletions"
|
|
D ASK^RCRCACP K DIR I $G(Y)'=1 W !,"Okay nothing deleted." G DELQ
|
|
W !!,"Deleting ..."
|
|
S RCX=0 F S RCX=$O(^TMP("RCRCE",$J,"SEL",RCX)) Q:'RCX D
|
|
.S DA=$G(^TMP("RCRCEX",$J,RCX)),RCLN=+DA,DA=$P(DA,U,2)
|
|
.I $D(^RCT(349.3,DA,0)) D
|
|
..S DIK="^RCT(349.3," D ^DIK
|
|
..W !,$G(^TMP("RCRCE",$J,RCLN,0))
|
|
..D FLDTEXT^VALM10(RCLN,"SUBJECT",RCY)
|
|
S RCOUT="" W !!,"REMEMBER: Resequence List to remove Deleted Items from list.",!
|
|
DELQ Q
|
|
;
|
|
VEW ;View/Forward XM Message
|
|
N DA,DIR,DIROUT,DUOUT,RCLN,RCX,X,Y
|
|
S RCOUT="",RCX=0 F S RCX=$O(^TMP("RCRCE",$J,"SEL",RCX)) Q:('RCX)!(RCOUT["^") D
|
|
.S DA=$G(^TMP("RCRCEX",$J,RCX)),RCLN=+DA,DA=$P(DA,U,2)
|
|
.I '$D(^RCT(349.3,+DA,0)) W !!,"Item ",RCX,".",?5," Transmission Entry no longer exists.",!!
|
|
.I $D(^RCT(349.3,+DA,0)) D VEWD I RCOUT="^" Q
|
|
.W ! S DIR(0)="E" D ^DIR I $D(DIROUT)!$D(DUOUT) S RCOUT="^" Q
|
|
.W @IOF
|
|
VEWQ Q
|
|
VEWD ;Display message
|
|
N DIR,DIROUT,DUOUT,RCI,RCY,X,XMER,XMPOS,XMRG,XMZ,X,Y W @IOF
|
|
S RCI=$G(^RCT(349.3,+DA,0)),XMZ=+RCI
|
|
S RCY=$$NET^XMRENT(XMZ)
|
|
I RCY="" W !!,RCX,".",?5," Mail Message #["_XMZ_"] no longer exists on this system.",! S XMZ=0 G VEWDQ
|
|
W !,RCX,"."
|
|
W !,"Subj: "_$P(RCY,U,6)_" [#"_XMZ_"] "_$P(RCY,U,1)
|
|
W !,"From: "_$P(RCY,U,3)
|
|
W !,"Message ID: "_$P(RCY,U,4)
|
|
W !,"Recipient: "_$P(RCI,U,4)
|
|
W !! F X=1:1:(IOM-1) W "="
|
|
W !
|
|
F W !,$$READ^XMGAPI1() Q:(XMER=-1)!(RCOUT="^") I ($Y+3)>IOSL D
|
|
.W ! S DIR(0)="E" D ^DIR I $D(DIROUT)!$D(DUOUT) S RCOUT="^" Q
|
|
.W @IOF
|
|
I RCTAG="FRW" W !! I XMZ D ENT2^XMD
|
|
VEWDQ Q
|
|
;
|
|
;RCRCXMS
|