ENAR2.m

ENAR2 ;(WASH ISC)/JED/DH-Archive Module ;3-9-89

 ;;7.0;ENGINEERING;;Aug 17, 1993

 ;EXPANSION OF ENAR1, CALLED BY ENAR1

ID ;DISPLAY ID INFO

 I '$D(ENDA),'($D(^ENAR(ENGBL,-1))#10) D ID1 Q

 I '$D(ENDA) S ENID=^ENAR(ENGBL,-1) S:$D(@ENID)=1 ENDA=+$P(ENID,",",4) I $D(@ENID)'=1 D ID1 Q

 I $E(IOST)'="P" S (DA,DJDN,W(1))=ENDA,(DJNM,DJSC)="ENAR",DJDIS=1 D ^ENJPARAM Q:'$D(DJRJ)  D ^ENJDPL,^ENJC2

 I $E(IOST)="P" S DIC="^ENG(6919,",DA=ENDA D EN^DIQ K DIC,DA Q

 K DA,DJCL,DJCP,DJDD,DJDIS,DJDN,DJDPL,DJEOP,DJF,DJFF,DJHIN,DJJ,DJK,DJKEY,DJRJ,DJSC,DJST,DJT,W,V Q

ID1 W !,"Insufficient data to display the ID information." Q

C ;CONFIRM ID DISPLAY

 D ID W !!!!,"Please confirm, is this the expected archive record" S %=1 D YN^DICN Q:%=1

 I %=0 W !,"The existing system archive global has the following ID information",!! G C

 S ENERR="ARCHIVE RECORD NOT CONFIRMED"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ENAR2   867     printed  Feb 18, 2025@23:17:54                                                                                                                                                                                                        Page 2

ENAR2     ;(WASH ISC)/JED/DH-Archive Module ;3-9-89

 +1       ;;7.0;ENGINEERING;;Aug 17, 1993

 +2       ;EXPANSION OF ENAR1, CALLED BY ENAR1

ID        ;DISPLAY ID INFO

 +1        IF '$DATA(ENDA)

               IF '($DATA(^ENAR(ENGBL,-1))#10)

                   DO ID1

                   QUIT 

 +2        IF '$DATA(ENDA)

               SET ENID=^ENAR(ENGBL,-1)

               if $DATA(@ENID)=1

                   SET ENDA=+$PIECE(ENID,",",4)

               IF $DATA(@ENID)'=1

                   DO ID1

                   QUIT 

 +3        IF $EXTRACT(IOST)'="P"

               SET (DA,DJDN,W(1))=ENDA

               SET (DJNM,DJSC)="ENAR"

               SET DJDIS=1

               DO ^ENJPARAM

               if '$DATA(DJRJ)

                   QUIT 

               DO ^ENJDPL

               DO ^ENJC2

 +4        IF $EXTRACT(IOST)="P"

               SET DIC="^ENG(6919,"

               SET DA=ENDA

               DO EN^DIQ

               KILL DIC,DA

               QUIT 

 +5        KILL DA,DJCL,DJCP,DJDD,DJDIS,DJDN,DJDPL,DJEOP,DJF,DJFF,DJHIN,DJJ,DJK,DJKEY,DJRJ,DJSC,DJST,DJT,W,V

           QUIT 

ID1        WRITE !,"Insufficient data to display the ID information."

           QUIT 

C         ;CONFIRM ID DISPLAY

 +1        DO ID

           WRITE !!!!,"Please confirm, is this the expected archive record"

           SET %=1

           DO YN^DICN

           if %=1

               QUIT 

 +2        IF %=0

               WRITE !,"The existing system archive global has the following ID information",!!

               GOTO C

 +3        SET ENERR="ARCHIVE RECORD NOT CONFIRMED"

 +4        QUIT