Home Package List Routine Alphabetical List Global Alphabetical List FileMan Files List FileMan Sub-Files List Package Component Lists Package-Namespace Mapping
Routine: DG53134P

DG53134P.m

Go to the documentation of this file.

DG53134P ;ALB/CAW - Add Integration Name if needed

 ;;5.3;Registration;**134**;Aug 13, 1993

POST N DG

 S DG=$G(XPDQUES("POS01")) I $L(DG)>3 D

 .S DG1=$O(^VA(389.9,"AIVDT1",1,-DT)),DA=$O(^VA(389.9,"AIVDT1",1,DG1,0))

 .S DIE="^VA(389.9,",DR=17000_"///"_DG D ^DIE

 K DA,DIE,DR,DG,DG1 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53134P   294     printed  Apr 09, 2024@21:50:54                                                                                                                                                                                                     Page 2

DG53134P  ;ALB/CAW - Add Integration Name if needed

 +1       ;;5.3;Registration;**134**;Aug 13, 1993

 +2       ;

POST       NEW DG

 +1        SET DG=$GET(XPDQUES("POS01"))

           IF $LENGTH(DG)>3

               Begin DoDot:1

 +2                SET DG1=$ORDER(^VA(389.9,"AIVDT1",1,-DT))

                   SET DA=$ORDER(^VA(389.9,"AIVDT1",1,DG1,0))

 +3                SET DIE="^VA(389.9,"

                   SET DR=17000_"///"_DG

                   DO ^DIE

               End DoDot:1

 +4        KILL DA,DIE,DR,DG,DG1

           QUIT