DVBCTXML ;ALB/BG/CP/JD - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 12/4/23 10:33am
;;2.7;AMIE;**250,252,254**;Apr 10, 1995;Build 41
; Per VHA Directive 6402 this routine should not be modified
; Reference to SUPPORTED PARAMETER TOOL ENTRY POINTS in ICR #2263
; Reference to $$NOW^XLFDT and $$FMTE^XLFDT in ICR #10103
Q
;Made changes for CAPRI-11238. JD - 6/17/24
FAILIST(DVBFAIL,DVBDUZ) ; rpc entry to return list of failed xml transmissions
;RPC: DVBA CAPRI DBQ TRANS FAIL LIST
;Added DVBWOI and DVBWON to the list for CAPRI-11238.
N DVBNCT,DVBAUTH,DVBALL,DVBLIST,DVBSTA,DVBNAME,DVBORG,DVBNOW,DVBCOMP,DVBPT,DVBIEN,DVBCT,DVBFLAG,DVBDATE,DVBPATCH,DVBWOI,DVBWON,DVBCMT,DVBCTFLAG
K ^TMP("CAPRI XML LIST",$J) S DVBNCT=""
S DVBALL=1 I '$D(DVBDUZ) S DVBALL=0
S DVBPATCH=3231025,DVBIEN=""
S DVBDATE=DVBPATCH F S DVBDATE=$O(^DVB(396.17,"C",DVBDATE)) Q:DVBDATE="" D
.S DVBIEN="" F S DVBIEN=$O(^DVB(396.17,"C",DVBDATE,DVBIEN)) Q:DVBIEN="" D
..I '$D(^DVB(396.17,DVBIEN,14,"B")) Q
..;Add CMT toggle parameter check CAPRI-10630 RJA 06/26/24
..S DVBCMT=0 D TOGGLE^DVBUTIL(.DVBCMT)
..S DVBCTFLAG=0 D PASCALCHK^DVBCTPDF(.DVBCTFLAG,DVBIEN)
..Q:DVBCMT=1&(DVBCTFLAG="P")!(DVBCMT=2&(DVBCTFLAG="C"))
..;Next 2 lines added for CAPRI-11238.
..S DVBWOI=$$GET1^DIQ(396.17,DVBIEN,"13","I") ;Worksheet originator IEN
..S DVBWON=$$GET1^DIQ(396.17,DVBIEN,"13","E") ;Worksheet originator name
..;Added the Worksheet Originator IEN (DVBWOI) check for CAPRI-11238.
..S DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I") I (DVBALL=1),($G(DVBDUZ)'=DVBAUTH),($G(DVBDUZ)'=DVBWOI) Q
..S DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
..S DVBCT=0 F S DVBCT=$O(^DVB(396.17,DVBIEN,14,"B",DVBCT)) Q:DVBCT="" D
...S DVBFLAG=0,DVBINN=""_DVBCT_","_DVBIEN_","_""
...S DVBSTA=$$GET1^DIQ(396.1726,DVBINN,".02","I")
...I DVBSTA="C" Q
...S DVBORG=$$GET1^DIQ(396.1726,DVBINN,".05","I")
...S DVBNAME=$$GET1^DIQ(396.1726,DVBINN,".03","I")
...;;Update Reports to remove version on display CAPRI-9567 CP 5/14/24
...I DVBNAME["_" S DVBNAME=$$NAMEUPD^DVBCTPD2(DVBNAME)
...I DVBNAME?.N S DVBNAME=$$GET1^DIQ(396.1726,DVBINN,".03","E")
...S DVBNOW=$$NOW^XLFDT S DVBDT=$$FMDIFF^XLFDT(DVBNOW,DVBORG,3)
...S DVBCOMP=$P(DVBDT," ",1) I DVBCOMP>=1 S DVBFLAG=1
...S DVBORG=$$FMTE^XLFDT(DVBORG,1)
...;Added the Worksheet Originator (DVBWOI,DVBWON) to the return list for CAPRI-11238.
...S DVBLIST=DVBIEN_U_DVBCT_U_DVBNAME_U_DVBPT_U_DVBORG_U_DVBFLAG_U_DVBWON_";"
...S DVBNCT=DVBNCT+1 M ^TMP("CAPRI XML LIST",$J,DVBNCT)=DVBLIST
...Q
S DVBFAIL=$NA(^TMP("CAPRI XML LIST",$J))
Q
;
FAILXML(DVBXML,DVBIEN,DVBCT) ;
;RPC: DVBA CAPRI GET DBQ XML
N DVBABCNT,DVBFXML,DVNCT,DVBFXML,DVBABIEN K ^TMP("DVBAXML",$J)
I '$D(^DVB(396.17,DVBIEN)) S DVBXML="0^NO RECORD EXISTS" Q
I '$D(^DVB(396.17,DVBIEN,14,DVBCT)) S DVBXML="0^NO RECORD EXISTS" Q
S DVBABCNT=1,DVBABIEN=0,DVNCT=0
S DVBRTN=$$LOCK(DVBIEN,DVBCT) I DVBRTN=0 S DVBXML="1^LOCKED RECORD" Q
F S DVBABIEN=$O(^DVB(396.17,DVBIEN,14,DVBCT,3,DVBABIEN)) Q:'DVBABIEN D
.S DVBFXML=$G(^DVB(396.17,DVBIEN,14,DVBCT,3,DVBABCNT,0))
.I DVBABCNT=1 S DVBFXML="1"_U_DVBFXML
.S DVBABCNT=DVBABCNT+1,DVNCT=DVNCT+1 M ^TMP("DVBAXML",$J,DVNCT)=DVBFXML
.Q
S DVBXML=$NA(^TMP("DVBAXML",$J))
D UNLOCK(DVBIEN,DVBCT)
Q
;
SAVEXML(DVBRTN,DVBNAME,DVBCT,DVBPM1,DVBPM2,DVBPM3,DVBPM4,DVBPM5) ;
;RPC: DVBA CAPRI SAVE DBQ XML
;Updates CAPRI-16627 CP 3/10/25
K DVBXML,DVBSTAT,DVBRESP,DVBIEN
I $G(DVBCT)="" S DVBCT=1
I $G(DVBPM5)'="" S DVBSTAT=DVBPM3,DVBRESP=DVBPM4,DVBIEN=DVBPM5 M DVBXML=DVBPM2
I $G(DVBPM5)="" S DVBSTAT=DVBPM2,DVBRESP=DVBPM3,DVBIEN=DVBPM4 M DVBXML=DVBPM1
S DVBRESP="Initial Save"
S DVBRTN=0
D STATUS(.DVBRTN,DVBIEN,DVBCT,DVBNAME,DVBSTAT,DVBRESP)
I $E(DVBRTN,1,2)="-1" Q
D FILEIN(.DVBRTN,DVBIEN,DVBCT,.DVBXML)
K DIC,DIE,DA,DR,DLAYGO,X,Y
S DVBRTN=DVBRTN
Q
FILEIN(DVBRTN,DVBIEN,DVBCT,DVBXML) ;
N DVBERR
D LOCK(DVBIEN,DVBCT)
D WP^DIE(396.1726,DVBCT_","_DVBIEN_",",.04,"K","DVBXML","DVBERR")
I $D(DVBERR) S DVBRTN="-1^XML did not save"
S DVBRTN=DVBRTN
D UNLOCK(DVBIEN,DVBCT)
Q
STATUS(DVBRTN,DVBIEN,DVBCT,DVBNAME,DVBSTAT,DVBRESP) ;
;RPC Direct Call: DVBA CAPRI UPDATE DBQ TRANSTAT
N DVBCNT,DVBDT,DVBNWIEN,DVBINN,DVBTRANS,DVBSTA,DVBDATA,DVBERR
S DVBRTN=0
S DVBSTA=$S(DVBSTAT=1:"C",1:"E")
I '$D(DVBRESP)!(DVBRESP="")&(DVBSTA="C") S DVBRESP="TRANSMISSION COMPLETE"
S DVBDT=$$NOW^XLFDT,DVBCNT=""
S DVBINN=DVBCT_","_DVBIEN_","
S DVBTRANS=$$GET1^DIQ(396.1726,DVBINN,".07","I")
I DVBRESP'="Initial Save" S DVBTRANS=$G(DVBTRANS)+1
I DVBTRANS="" S DVBTRANS=0
K DIC,DIE,DA,DR,DLAYGO,X,Y
I $D(^DVB(396.17,DVBIEN,14,DVBCT))<10 D
. S DA(1)=DVBIEN,(DA,X)=DVBCT
. S (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",14,",DIC(0)="LZ"
. D ^DIC
. I Y="-1" S DVBRTN="-1^Can not save transmission" Q
I $E(DVBRTN,1,2)="-1" Q
S DVBDATA(396.1726,DVBINN,".02")=DVBSTA
S DVBDATA(396.1726,DVBINN,".07")=DVBTRANS
I DVBSTA="C" S DVBDATA(396.1726,DVBINN,".09")=DVBDT
I DVBNAME'="" S DVBDATA(396.1726,DVBINN,".03")=DVBNAME
I DVBRESP="Initial Save" S DVBDATA(396.1726,DVBINN,".05")=DVBDT
D UPDATE^DIE("","DVBDATA","DVBIEN","DVBERR")
I $D(DVBERR) S DVBRTN="-1^Can not save details" Q
S DVBCNT=$O(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT),-1)
S DVBCNT=$G(DVBCNT)+1
K DIC,DIE,DA,DR,DLAYGO,X,Y
S DA(2)=DVBIEN,DA(1)=DVBCT,X=DVBCT
S (DLAYGO,DIC)="^DVB(396.17,"_DA(2)_",14,"_DA(1)_",10,",DIC(0)="LZ"
S DIC("DR")=".02////"_DVBDT_";.03////"_DUZ_";.04////"_DVBRESP
D FILE^DICN
I Y=-1 S DVBRTN="-1^Can not save transmission" Q
S DVBRTN=1
K DIC,DIE,DIERR,DA,DR,DLAYGO,X
Q
;
LOCK(DVBIEN,DVBCT) ;
L +^DVB(396.17,DVBIEN,14,DVBCT,3):30
S DVBRTN=$T
Q DVBRTN
;
UNLOCK(DVBIEN,DVBCT) ;
L -^DVB(396.17,DVBIEN,14,DVBCT,3)
Q
;
FAILCHK(DVBRTN) ;
;RPC: DVBA CAPRI FAIL CHECK
K DVBRTN S DVBRTN=0,DVBPATCH=3231025
S DVBDATE=DVBPATCH F S DVBDATE=$O(^DVB(396.17,"C",DVBDATE)) Q:(DVBDATE="")!(DVBRTN=1) D
.S DVBIEN="" F S DVBIEN=$O(^DVB(396.17,"C",DVBDATE,DVBIEN)) Q:(DVBIEN="")!(DVBRTN=1) D
..I $D(^DVB(396.17,DVBIEN,14,"B")) D
...S DVBCT=0 F S DVBCT=$O(^DVB(396.17,DVBIEN,14,"B",DVBCT)) Q:(DVBCT="")!(DVBRTN=1) D
....S DVBINN=""_DVBCT_","_DVBIEN_","_""
....S DVBSTA=$$GET1^DIQ(396.1726,DVBINN,".02","I")
....I DVBSTA'="C" S DVBRTN=1
Q
GITHUB(DVBRTN) ;
S DVBRTN=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB LINK")
Q
GITTOK(DVBRTN) ;
N DVBTOK,DVBAPP,DVBID,DVBRET,DVBCT,DVBCNT
K ^TMP("DVBTOKEN",$J)
S DVBAPP=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB APP ID")
S DVBID=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB INSTALL ID")
D GETWP^XPAR(.DVBTOK,"PKG","DVBAB CAPRI GITHUB TOKEN")
S DVBCT=0,DVBCNT=0 F S DVBCT=$O(DVBTOK(DVBCT)) Q:DVBCT="" D
.I DVBCNT=0 D
..S DVBCT=0,DVBRET(DVBCNT)=DVBAPP_U_DVBID
..M ^TMP("DVBTOKEN",$J,DVBCNT)=DVBRET(DVBCNT) S DVBCNT=DVBCNT+1,DVBCT=DVBCT+1
..Q
.S DVBRET(DVBCNT)=DVBTOK(DVBCT,0)
.S DVBRET(DVBCNT)=DVBTOK(DVBCT,0) M ^TMP("DVBTOKEN",$J,DVBCNT)=DVBRET(DVBCNT)
.S DVBCNT=DVBCNT+1
.Q
S DVBRTN=$NA(^TMP("DVBTOKEN",$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCTXML 7013 printed Sep 23, 2025@19:25:08 Page 2
DVBCTXML ;ALB/BG/CP/JD - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 12/4/23 10:33am
+1 ;;2.7;AMIE;**250,252,254**;Apr 10, 1995;Build 41
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; Reference to SUPPORTED PARAMETER TOOL ENTRY POINTS in ICR #2263
+4 ; Reference to $$NOW^XLFDT and $$FMTE^XLFDT in ICR #10103
+5 QUIT
+6 ;Made changes for CAPRI-11238. JD - 6/17/24
FAILIST(DVBFAIL,DVBDUZ) ; rpc entry to return list of failed xml transmissions
+1 ;RPC: DVBA CAPRI DBQ TRANS FAIL LIST
+2 ;Added DVBWOI and DVBWON to the list for CAPRI-11238.
+3 NEW DVBNCT,DVBAUTH,DVBALL,DVBLIST,DVBSTA,DVBNAME,DVBORG,DVBNOW,DVBCOMP,DVBPT,DVBIEN,DVBCT,DVBFLAG,DVBDATE,DVBPATCH,DVBWOI,DVBWON,DVBCMT,DVBCTFLAG
+4 KILL ^TMP("CAPRI XML LIST",$JOB)
SET DVBNCT=""
+5 SET DVBALL=1
IF '$DATA(DVBDUZ)
SET DVBALL=0
+6 SET DVBPATCH=3231025
SET DVBIEN=""
+7 SET DVBDATE=DVBPATCH
FOR
SET DVBDATE=$ORDER(^DVB(396.17,"C",DVBDATE))
if DVBDATE=""
QUIT
Begin DoDot:1
+8 SET DVBIEN=""
FOR
SET DVBIEN=$ORDER(^DVB(396.17,"C",DVBDATE,DVBIEN))
if DVBIEN=""
QUIT
Begin DoDot:2
+9 IF '$DATA(^DVB(396.17,DVBIEN,14,"B"))
QUIT
+10 ;Add CMT toggle parameter check CAPRI-10630 RJA 06/26/24
+11 SET DVBCMT=0
DO TOGGLE^DVBUTIL(.DVBCMT)
+12 SET DVBCTFLAG=0
DO PASCALCHK^DVBCTPDF(.DVBCTFLAG,DVBIEN)
+13 if DVBCMT=1&(DVBCTFLAG="P")!(DVBCMT=2&(DVBCTFLAG="C"))
QUIT
+14 ;Next 2 lines added for CAPRI-11238.
+15 ;Worksheet originator IEN
SET DVBWOI=$$GET1^DIQ(396.17,DVBIEN,"13","I")
+16 ;Worksheet originator name
SET DVBWON=$$GET1^DIQ(396.17,DVBIEN,"13","E")
+17 ;Added the Worksheet Originator IEN (DVBWOI) check for CAPRI-11238.
+18 SET DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I")
IF (DVBALL=1)
IF ($GET(DVBDUZ)'=DVBAUTH)
IF ($GET(DVBDUZ)'=DVBWOI)
QUIT
+19 SET DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
+20 SET DVBCT=0
FOR
SET DVBCT=$ORDER(^DVB(396.17,DVBIEN,14,"B",DVBCT))
if DVBCT=""
QUIT
Begin DoDot:3
+21 SET DVBFLAG=0
SET DVBINN=""_DVBCT_","_DVBIEN_","_""
+22 SET DVBSTA=$$GET1^DIQ(396.1726,DVBINN,".02","I")
+23 IF DVBSTA="C"
QUIT
+24 SET DVBORG=$$GET1^DIQ(396.1726,DVBINN,".05","I")
+25 SET DVBNAME=$$GET1^DIQ(396.1726,DVBINN,".03","I")
+26 ;;Update Reports to remove version on display CAPRI-9567 CP 5/14/24
+27 IF DVBNAME["_"
SET DVBNAME=$$NAMEUPD^DVBCTPD2(DVBNAME)
+28 IF DVBNAME?.N
SET DVBNAME=$$GET1^DIQ(396.1726,DVBINN,".03","E")
+29 SET DVBNOW=$$NOW^XLFDT
SET DVBDT=$$FMDIFF^XLFDT(DVBNOW,DVBORG,3)
+30 SET DVBCOMP=$PIECE(DVBDT," ",1)
IF DVBCOMP>=1
SET DVBFLAG=1
+31 SET DVBORG=$$FMTE^XLFDT(DVBORG,1)
+32 ;Added the Worksheet Originator (DVBWOI,DVBWON) to the return list for CAPRI-11238.
+33 SET DVBLIST=DVBIEN_U_DVBCT_U_DVBNAME_U_DVBPT_U_DVBORG_U_DVBFLAG_U_DVBWON_";"
+34 SET DVBNCT=DVBNCT+1
MERGE ^TMP("CAPRI XML LIST",$JOB,DVBNCT)=DVBLIST
+35 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+36 SET DVBFAIL=$NAME(^TMP("CAPRI XML LIST",$JOB))
+37 QUIT
+38 ;
FAILXML(DVBXML,DVBIEN,DVBCT) ;
+1 ;RPC: DVBA CAPRI GET DBQ XML
+2 NEW DVBABCNT,DVBFXML,DVNCT,DVBFXML,DVBABIEN
KILL ^TMP("DVBAXML",$JOB)
+3 IF '$DATA(^DVB(396.17,DVBIEN))
SET DVBXML="0^NO RECORD EXISTS"
QUIT
+4 IF '$DATA(^DVB(396.17,DVBIEN,14,DVBCT))
SET DVBXML="0^NO RECORD EXISTS"
QUIT
+5 SET DVBABCNT=1
SET DVBABIEN=0
SET DVNCT=0
+6 SET DVBRTN=$$LOCK(DVBIEN,DVBCT)
IF DVBRTN=0
SET DVBXML="1^LOCKED RECORD"
QUIT
+7 FOR
SET DVBABIEN=$ORDER(^DVB(396.17,DVBIEN,14,DVBCT,3,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+8 SET DVBFXML=$GET(^DVB(396.17,DVBIEN,14,DVBCT,3,DVBABCNT,0))
+9 IF DVBABCNT=1
SET DVBFXML="1"_U_DVBFXML
+10 SET DVBABCNT=DVBABCNT+1
SET DVNCT=DVNCT+1
MERGE ^TMP("DVBAXML",$JOB,DVNCT)=DVBFXML
+11 QUIT
End DoDot:1
+12 SET DVBXML=$NAME(^TMP("DVBAXML",$JOB))
+13 DO UNLOCK(DVBIEN,DVBCT)
+14 QUIT
+15 ;
SAVEXML(DVBRTN,DVBNAME,DVBCT,DVBPM1,DVBPM2,DVBPM3,DVBPM4,DVBPM5) ;
+1 ;RPC: DVBA CAPRI SAVE DBQ XML
+2 ;Updates CAPRI-16627 CP 3/10/25
+3 KILL DVBXML,DVBSTAT,DVBRESP,DVBIEN
+4 IF $GET(DVBCT)=""
SET DVBCT=1
+5 IF $GET(DVBPM5)'=""
SET DVBSTAT=DVBPM3
SET DVBRESP=DVBPM4
SET DVBIEN=DVBPM5
MERGE DVBXML=DVBPM2
+6 IF $GET(DVBPM5)=""
SET DVBSTAT=DVBPM2
SET DVBRESP=DVBPM3
SET DVBIEN=DVBPM4
MERGE DVBXML=DVBPM1
+7 SET DVBRESP="Initial Save"
+8 SET DVBRTN=0
+9 DO STATUS(.DVBRTN,DVBIEN,DVBCT,DVBNAME,DVBSTAT,DVBRESP)
+10 IF $EXTRACT(DVBRTN,1,2)="-1"
QUIT
+11 DO FILEIN(.DVBRTN,DVBIEN,DVBCT,.DVBXML)
+12 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+13 SET DVBRTN=DVBRTN
+14 QUIT
FILEIN(DVBRTN,DVBIEN,DVBCT,DVBXML) ;
+1 NEW DVBERR
+2 DO LOCK(DVBIEN,DVBCT)
+3 DO WP^DIE(396.1726,DVBCT_","_DVBIEN_",",.04,"K","DVBXML","DVBERR")
+4 IF $DATA(DVBERR)
SET DVBRTN="-1^XML did not save"
+5 SET DVBRTN=DVBRTN
+6 DO UNLOCK(DVBIEN,DVBCT)
+7 QUIT
STATUS(DVBRTN,DVBIEN,DVBCT,DVBNAME,DVBSTAT,DVBRESP) ;
+1 ;RPC Direct Call: DVBA CAPRI UPDATE DBQ TRANSTAT
+2 NEW DVBCNT,DVBDT,DVBNWIEN,DVBINN,DVBTRANS,DVBSTA,DVBDATA,DVBERR
+3 SET DVBRTN=0
+4 SET DVBSTA=$SELECT(DVBSTAT=1:"C",1:"E")
+5 IF '$DATA(DVBRESP)!(DVBRESP="")&(DVBSTA="C")
SET DVBRESP="TRANSMISSION COMPLETE"
+6 SET DVBDT=$$NOW^XLFDT
SET DVBCNT=""
+7 SET DVBINN=DVBCT_","_DVBIEN_","
+8 SET DVBTRANS=$$GET1^DIQ(396.1726,DVBINN,".07","I")
+9 IF DVBRESP'="Initial Save"
SET DVBTRANS=$GET(DVBTRANS)+1
+10 IF DVBTRANS=""
SET DVBTRANS=0
+11 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+12 IF $DATA(^DVB(396.17,DVBIEN,14,DVBCT))<10
Begin DoDot:1
+13 SET DA(1)=DVBIEN
SET (DA,X)=DVBCT
+14 SET (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",14,"
SET DIC(0)="LZ"
+15 DO ^DIC
+16 IF Y="-1"
SET DVBRTN="-1^Can not save transmission"
QUIT
End DoDot:1
+17 IF $EXTRACT(DVBRTN,1,2)="-1"
QUIT
+18 SET DVBDATA(396.1726,DVBINN,".02")=DVBSTA
+19 SET DVBDATA(396.1726,DVBINN,".07")=DVBTRANS
+20 IF DVBSTA="C"
SET DVBDATA(396.1726,DVBINN,".09")=DVBDT
+21 IF DVBNAME'=""
SET DVBDATA(396.1726,DVBINN,".03")=DVBNAME
+22 IF DVBRESP="Initial Save"
SET DVBDATA(396.1726,DVBINN,".05")=DVBDT
+23 DO UPDATE^DIE("","DVBDATA","DVBIEN","DVBERR")
+24 IF $DATA(DVBERR)
SET DVBRTN="-1^Can not save details"
QUIT
+25 SET DVBCNT=$ORDER(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT),-1)
+26 SET DVBCNT=$GET(DVBCNT)+1
+27 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+28 SET DA(2)=DVBIEN
SET DA(1)=DVBCT
SET X=DVBCT
+29 SET (DLAYGO,DIC)="^DVB(396.17,"_DA(2)_",14,"_DA(1)_",10,"
SET DIC(0)="LZ"
+30 SET DIC("DR")=".02////"_DVBDT_";.03////"_DUZ_";.04////"_DVBRESP
+31 DO FILE^DICN
+32 IF Y=-1
SET DVBRTN="-1^Can not save transmission"
QUIT
+33 SET DVBRTN=1
+34 KILL DIC,DIE,DIERR,DA,DR,DLAYGO,X
+35 QUIT
+36 ;
LOCK(DVBIEN,DVBCT) ;
+1 LOCK +^DVB(396.17,DVBIEN,14,DVBCT,3):30
+2 SET DVBRTN=$TEST
+3 QUIT DVBRTN
+4 ;
UNLOCK(DVBIEN,DVBCT) ;
+1 LOCK -^DVB(396.17,DVBIEN,14,DVBCT,3)
+2 QUIT
+3 ;
FAILCHK(DVBRTN) ;
+1 ;RPC: DVBA CAPRI FAIL CHECK
+2 KILL DVBRTN
SET DVBRTN=0
SET DVBPATCH=3231025
+3 SET DVBDATE=DVBPATCH
FOR
SET DVBDATE=$ORDER(^DVB(396.17,"C",DVBDATE))
if (DVBDATE="")!(DVBRTN=1)
QUIT
Begin DoDot:1
+4 SET DVBIEN=""
FOR
SET DVBIEN=$ORDER(^DVB(396.17,"C",DVBDATE,DVBIEN))
if (DVBIEN="")!(DVBRTN=1)
QUIT
Begin DoDot:2
+5 IF $DATA(^DVB(396.17,DVBIEN,14,"B"))
Begin DoDot:3
+6 SET DVBCT=0
FOR
SET DVBCT=$ORDER(^DVB(396.17,DVBIEN,14,"B",DVBCT))
if (DVBCT="")!(DVBRTN=1)
QUIT
Begin DoDot:4
+7 SET DVBINN=""_DVBCT_","_DVBIEN_","_""
+8 SET DVBSTA=$$GET1^DIQ(396.1726,DVBINN,".02","I")
+9 IF DVBSTA'="C"
SET DVBRTN=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
GITHUB(DVBRTN) ;
+1 SET DVBRTN=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB LINK")
+2 QUIT
GITTOK(DVBRTN) ;
+1 NEW DVBTOK,DVBAPP,DVBID,DVBRET,DVBCT,DVBCNT
+2 KILL ^TMP("DVBTOKEN",$JOB)
+3 SET DVBAPP=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB APP ID")
+4 SET DVBID=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB INSTALL ID")
+5 DO GETWP^XPAR(.DVBTOK,"PKG","DVBAB CAPRI GITHUB TOKEN")
+6 SET DVBCT=0
SET DVBCNT=0
FOR
SET DVBCT=$ORDER(DVBTOK(DVBCT))
if DVBCT=""
QUIT
Begin DoDot:1
+7 IF DVBCNT=0
Begin DoDot:2
+8 SET DVBCT=0
SET DVBRET(DVBCNT)=DVBAPP_U_DVBID
+9 MERGE ^TMP("DVBTOKEN",$JOB,DVBCNT)=DVBRET(DVBCNT)
SET DVBCNT=DVBCNT+1
SET DVBCT=DVBCT+1
+10 QUIT
End DoDot:2
+11 SET DVBRET(DVBCNT)=DVBTOK(DVBCT,0)
+12 SET DVBRET(DVBCNT)=DVBTOK(DVBCT,0)
MERGE ^TMP("DVBTOKEN",$JOB,DVBCNT)=DVBRET(DVBCNT)
+13 SET DVBCNT=DVBCNT+1
+14 QUIT
End DoDot:1
+15 SET DVBRTN=$NAME(^TMP("DVBTOKEN",$JOB))
+16 QUIT
