DVBCANRS.m

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 ---DVBCANRS   894     printed  Apr 09, 2024@20:46:54                                                                                                                                                                                                     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