DVBCPSH1.m

DVBCPSH1 ;ALB/AKG - CAPRI PUSH UTILITY RPC CONT; MAY 9, 2023@9:47am ; 5/16/23 3:35pm

 ;;2.7;AMIE;**248**;Apr 10, 1995;Build 6

 ;Per VHA Directive 6402 this routine should not be modified

 ;

 Q

 ;

EXINACT(DVBMSG,DVBIEN,DVBSTAT) ;

 ;inactivates entry in 396.6

 N DVBNWSTT K DIC,DIE,DA,DR,X,Y

 S DA=DVBIEN,DIE="^DVB(396.6,",DIC(0)="L"

 S DR=".5///"_DVBSTAT D ^DIE

 K DIC,DIE,DA,DR,X,Y

 S DVBNWSTT=$$GET1^DIQ(396.6,DVBIEN,.5,"I")

 S DVBMSG=$S(DVBNWSTT=DVBSTAT:"1^Record edited",1:"0^Record not edited")

 Q

EXEDIT(DVBMSG,DVBIEN,DVBNAME) ; 

 N DVBBODY,DVBPNM,DVBWK,DVBSTAT,DVBNSTT

 I $G(DVBIEN)="" S DVBMSG="0^Missing IEN" Q

 I $G(DVBNAME)="" S DVBMSG="0^Missing Name" Q

 S DVBWK=$$GET1^DIQ(396.6,DVBIEN,.07,"I")

 S DVBBODY=$$GET1^DIQ(396.6,DVBIEN,2,"I")

 S DVBPNM=$$GET1^DIQ(396.6,DVBIEN,6,"I")

 S DVBSTAT="I"

 D EXINACT(.DVBMSG,DVBIEN,DVBSTAT)

 I $P(DVBMSG,U,1)=0 S DVBMSG="RECORD NOT EDITED" Q

 K DIC,DA,DR,DIE,X,Y

 S DIC=396.6,DIC(0)="Z",X=DVBNAME D FILE^DICN

 S (DA,X)=+Y,DIE=DIC

 S DR=".07///"_DVBWK_";2///"_DVBBODY_";6///"_DVBPNM_";.5///A"

 D ^DIE

 S DVBNSTT=$$GET1^DIQ(396.6,DVBIEN,.5,"I")

 K DIC,DA,DR,DIE,X,Y

 S DVBMSG=$S(DVBNSTT=DVBSTAT:"1^Record edited",1:"0^Record not edited")

 Q

LISTSTAT(DVBMSG,DVBSTAT) ;

 ;list AMIE Exam Names according to status

 N DVBIEN,DVBCNT,DVBRET

 K ^TMP("DVBLSTAT",$J)

 S DVBIEN=0,DVBCNT=0

 F  S DVBIEN=$O(^DVB(396.6,DVBIEN)) Q:DVBIEN=""!('DVBIEN)  D

 .I $P($G(^DVB(396.6,DVBIEN,0)),U,5)'=DVBSTAT Q

 .S DVBRET(DVBCNT)=$P(^DVB(396.6,DVBIEN,0),"^",1)_"^"_DVBIEN

 .M ^TMP("DVBLSTAT",$J,DVBCNT)=DVBRET(DVBCNT)

 .S DVBCNT=DVBCNT+1

 .Q

 S DVBMSG=$NA(^TMP("DVBLSTAT",$J))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBCPSH1   1651     printed  Mar 13, 2025@20:50:02                                                                                                                                                                                                    Page 2

DVBCPSH1  ;ALB/AKG - CAPRI PUSH UTILITY RPC CONT; MAY 9, 2023@9:47am ; 5/16/23 3:35pm

 +1       ;;2.7;AMIE;**248**;Apr 10, 1995;Build 6

 +2       ;Per VHA Directive 6402 this routine should not be modified

 +3       ;

 +4        QUIT 

 +5       ;

EXINACT(DVBMSG,DVBIEN,DVBSTAT) ;

 +1       ;inactivates entry in 396.6

 +2        NEW DVBNWSTT

           KILL DIC,DIE,DA,DR,X,Y

 +3        SET DA=DVBIEN

           SET DIE="^DVB(396.6,"

           SET DIC(0)="L"

 +4        SET DR=".5///"_DVBSTAT

           DO ^DIE

 +5        KILL DIC,DIE,DA,DR,X,Y

 +6        SET DVBNWSTT=$$GET1^DIQ(396.6,DVBIEN,.5,"I")

 +7        SET DVBMSG=$SELECT(DVBNWSTT=DVBSTAT:"1^Record edited",1:"0^Record not edited")

 +8        QUIT 

EXEDIT(DVBMSG,DVBIEN,DVBNAME) ; 

 +1        NEW DVBBODY,DVBPNM,DVBWK,DVBSTAT,DVBNSTT

 +2        IF $GET(DVBIEN)=""

               SET DVBMSG="0^Missing IEN"

               QUIT 

 +3        IF $GET(DVBNAME)=""

               SET DVBMSG="0^Missing Name"

               QUIT 

 +4        SET DVBWK=$$GET1^DIQ(396.6,DVBIEN,.07,"I")

 +5        SET DVBBODY=$$GET1^DIQ(396.6,DVBIEN,2,"I")

 +6        SET DVBPNM=$$GET1^DIQ(396.6,DVBIEN,6,"I")

 +7        SET DVBSTAT="I"

 +8        DO EXINACT(.DVBMSG,DVBIEN,DVBSTAT)

 +9        IF $PIECE(DVBMSG,U,1)=0

               SET DVBMSG="RECORD NOT EDITED"

               QUIT 

 +10       KILL DIC,DA,DR,DIE,X,Y

 +11       SET DIC=396.6

           SET DIC(0)="Z"

           SET X=DVBNAME

           DO FILE^DICN

 +12       SET (DA,X)=+Y

           SET DIE=DIC

 +13       SET DR=".07///"_DVBWK_";2///"_DVBBODY_";6///"_DVBPNM_";.5///A"

 +14       DO ^DIE

 +15       SET DVBNSTT=$$GET1^DIQ(396.6,DVBIEN,.5,"I")

 +16       KILL DIC,DA,DR,DIE,X,Y

 +17       SET DVBMSG=$SELECT(DVBNSTT=DVBSTAT:"1^Record edited",1:"0^Record not edited")

 +18       QUIT 

LISTSTAT(DVBMSG,DVBSTAT) ;

 +1       ;list AMIE Exam Names according to status

 +2        NEW DVBIEN,DVBCNT,DVBRET

 +3        KILL ^TMP("DVBLSTAT",$JOB)

 +4        SET DVBIEN=0

           SET DVBCNT=0

 +5        FOR 

               SET DVBIEN=$ORDER(^DVB(396.6,DVBIEN))

               if DVBIEN=""!('DVBIEN)

                   QUIT 

               Begin DoDot:1

 +6                IF $PIECE($GET(^DVB(396.6,DVBIEN,0)),U,5)'=DVBSTAT

                       QUIT 

 +7                SET DVBRET(DVBCNT)=$PIECE(^DVB(396.6,DVBIEN,0),"^",1)_"^"_DVBIEN

 +8                MERGE ^TMP("DVBLSTAT",$JOB,DVBCNT)=DVBRET(DVBCNT)

 +9                SET DVBCNT=DVBCNT+1

 +10               QUIT 

               End DoDot:1

 +11       SET DVBMSG=$NAME(^TMP("DVBLSTAT",$JOB))

 +12       QUIT