source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCCNC1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1DVBCCNC1 ;ALB ISC/THM-CANCEL ENTIRE REQUEST ; 9/22/91 4:14 PM
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4ALL K NONE W ! S ALLCANC=1,DIC="^DVB(396.5,",DIC(0)="AEQM",DIC("A")="Enter REASON FOR CANCELLATION: " D ^DIC G:X=""!(X=U)!(+Y'>0) EXIT^DVBCCNCL S REAS=+Y
5 ;
6BY W !,"Cancelled by (M)AS or (R)O? M// "
7 R BY:DTIME
8 G:'$T!(BY=U) EXIT^DVBCCNCL
9 I BY=""!(BY="m") W:BY="" "M" S BY="M" ;echo selection
10 S:BY="r" BY="R"
11 I BY'?1"M"&(BY'?1"R") W !!,"Enter M to indicate cancellation by MAS or",!," R to indicate cancellation by the Regional Office.",!! G BY
12 W $S(BY="M":"AS",BY="R":"O",1:"") ;finish echo of selection
13 ;
14BY1 W *7,!!,"Cancelled by ",$S(BY="":"MAS",BY="M":"MAS",BY="R":"RO",1:"Unknown source")," Ok" S %=2 D YN^DICN G:$D(DTOUT)!(%<0) EXIT^DVBCCNCL
15 I $D(%Y),%Y["?" W !!,"Enter Y to verify or N to reselect",! G BY1
16 I $D(%),%'=1 G BY
17 S BY=$S(BY="R":"RX",BY="M":"X",1:"")
18 W !!
19 F JJZ=0:0 S JJZ=$O(^DVB(396.4,"C",DA(1),JJZ)) Q:JJZ="" S STAT=$P(^DVB(396.4,JJZ,0),U,4) I STAT="O" D ALL1
20 I '$D(CANC) S CANC("None - (Request only)")=BY_U_REAS ;used in case of request logging error (system)
21 H 1 S DA=DA(1),(DIC,DIE)="^DVB(396.3,",DR="17////"_BY_";19///NOW;20////^S X=DUZ" D ^DIE,NOTIFY,BULL I $D(OUT) G EXIT^DVBCCNCL
22 G LOOK^DVBCCNCL
23 ;
24ALL1 S EXMPTR=$P(^DVB(396.4,JJZ,0),U,3),EXMNM=$S($D(^DVB(396.6,+EXMPTR,0)):$P(^(0),U,1),1:"Unknown exam"_" ("_+EXMPTR_")") K EXMPTR ;show deleted exam
25 S DR=".04////"_BY_";52////"_REAS_";51////^S X=DUZ;50///NOW",DA=JJZ
26 S (DIC,DIE)="^DVB(396.4," D ^DIE
27 I '$D(Y) W:$X>50 ! W:$L(EXMNM)>25&($X>45) ! W EXMNM," cancelled, " S CANC(EXMNM)=BY_U_REAS
28 I $D(Y) W *7,!,"Cancellation error on ",EXMNM," exam !" H 2
29 Q
30 ;
31NOTIFY S X=$P(^DVB(396.3,DA,0),U,18) I X="RX"!(X="X") W !!,"Entire exam is now CANCELLED.",!! H 1 Q
32 I X'="RX"&(X'="X") W *7,!!,"Cancellation error !",!! H 3 S OUT=1
33 Q
34 ;
35BULL Q:'$D(CANC) S SEND=1,EXAM="" F JI=0:0 S EXAM=$O(CANC(EXAM)) Q:EXAM="" I $P(CANC(EXAM),U,1)'="X"&($P(CANC(EXAM),U,1)'="RX") S SEND=0 Q
36 I SEND=0 W *7,!!,"An error has occurred during cancellation - bulletin will not be sent!",!!,*7 H 3 Q
37 K OWNDOM,XDOM,DOMAIN,DOMNUM
38 I $D(ALLCANC) S OWNDOM=$P(^DVB(396.3,DA(1),0),U,22) I OWNDOM]"" S XDOM=$S($D(^DIC(4.2,OWNDOM,0)):^(0),1:"") S DOMAIN=$P(XDOM,U,1),DOMNUM=$S(+$P(XDOM,U,3)>0:+$P(XDOM,U,3),1:OWNDOM)
39 I $D(ALLCANC),OWNDOM]"" I +DOMNUM>0 S XMY("G.DVBA C 2507 CANCELLATION@"_DOMAIN)=DOMNUM W !!,*7,"I am sending a copy of this cancellation to the",!,"cancellation mail group at "_DOMAIN,!,"since this was transferred in.",!! H 2
40 I SEND=1 S REQDA=DA(1) D ^DVBCBULL I $D(ALLCANC),OWNDOM]"",+DOMNUM>0 S REQDA=DA(1) D EN1^DVBCXFRE
41 K ALLCANC,CANC,SEND,OWNDOM,DOMNUM
42 Q
Note: See TracBrowser for help on using the repository browser.