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

RCRCXMS.m

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