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