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 ---[H[J[2J[HDVBCPSH1 1651 printed Dec 13, 2024@01:45:20 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
