DVBCANRS ;ALB/RTW - PATCH DVBA*2.7*189 CANCEL REASON AND COMMENTS ROUTINE;08/08/2014
;;2.7;AMIE;**189,200**;Apr 10, 1995;Build 2
; At CANRSN This routine adds new 2507 cancellation reasons and hides reasons no longer needed in file 396.5 for VLER DAS-CAPRI
;
Q ;NO DIRECT ACCESS
CANRSN(DVBARRAY) ; RPC" DVBA CAPRI GETCANCELREASON
;This gets only active 2507 Cancellation reasons; they are stored in xref "D",1
N DVBCR
K ^TMP("DVB",$J)
S X=0
S DVBCR="" F S DVBCR=$O(^DVB(396.5,"D",1,DVBCR)) Q:'DVBCR D
.S DVBNM=$$GET1^DIQ(396.5,DVBCR,"NAME")
.Q:DVBNM=""
.S ^TMP("DVB",$J,DVBNM,DVBCR)=""
.Q
S DVBCNT=1,DVBCNA="" F S DVBCNA=$O(^TMP("DVB",$J,DVBCNA)) Q:DVBCNA="" D
.S DVBCA=1 F S DVBCA=$O(^TMP("DVB",$J,DVBCNA,DVBCA)) Q:'DVBCA D
..S DVBARRAY(DVBCNT)=DVBCA_"^"_DVBCNA
..S DVBCNT=DVBCNT+1
K DVBNM,DVBCR,DVBCNT,DVBCA,DVBCRA,DVBCNA,X
K ^TMP("DVB",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCANRS 894 printed Dec 13, 2024@01:43:32 Page 2
DVBCANRS ;ALB/RTW - PATCH DVBA*2.7*189 CANCEL REASON AND COMMENTS ROUTINE;08/08/2014
+1 ;;2.7;AMIE;**189,200**;Apr 10, 1995;Build 2
+2 ; At CANRSN This routine adds new 2507 cancellation reasons and hides reasons no longer needed in file 396.5 for VLER DAS-CAPRI
+3 ;
+4 ;NO DIRECT ACCESS
QUIT
CANRSN(DVBARRAY) ; RPC" DVBA CAPRI GETCANCELREASON
+1 ;This gets only active 2507 Cancellation reasons; they are stored in xref "D",1
+2 NEW DVBCR
+3 KILL ^TMP("DVB",$JOB)
+4 SET X=0
+5 SET DVBCR=""
FOR
SET DVBCR=$ORDER(^DVB(396.5,"D",1,DVBCR))
if 'DVBCR
QUIT
Begin DoDot:1
+6 SET DVBNM=$$GET1^DIQ(396.5,DVBCR,"NAME")
+7 if DVBNM=""
QUIT
+8 SET ^TMP("DVB",$JOB,DVBNM,DVBCR)=""
+9 QUIT
End DoDot:1
+10 SET DVBCNT=1
SET DVBCNA=""
FOR
SET DVBCNA=$ORDER(^TMP("DVB",$JOB,DVBCNA))
if DVBCNA=""
QUIT
Begin DoDot:1
+11 SET DVBCA=1
FOR
SET DVBCA=$ORDER(^TMP("DVB",$JOB,DVBCNA,DVBCA))
if 'DVBCA
QUIT
Begin DoDot:2
+12 SET DVBARRAY(DVBCNT)=DVBCA_"^"_DVBCNA
+13 SET DVBCNT=DVBCNT+1
End DoDot:2
End DoDot:1
+14 KILL DVBNM,DVBCR,DVBCNT,DVBCA,DVBCRA,DVBCNA,X
+15 KILL ^TMP("DVB",$JOB)
+16 QUIT
