- 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 Feb 18, 2025@23:14:25 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