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

DVBCTXML.m

Go to the documentation of this file.
  1. DVBCTXML ;ALB/BG - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 10/25/23 10:47am
  1. ;;2.7;AMIE;**250**;Apr 10, 1995;Build 19
  1. ; Per VHA Directive 6402 this routine should not be modified
  1. ; Reference to SUPPORTED PARAMETER TOOL ENTRY POINTS in ICR #2263
  1. ; Reference to $$NOW^XLFDT and $$FMTE^XLFDT in ICR #10103
  1. Q
  1. ;
  1. FAILIST(DVBFAIL,DVBDUZ) ; rpc entry to return list of failed xml transmissions
  1. N DVBNCT,DVBAUTH,DVBALL,DVBLIST,DVBSTA,DVBNAME,DVBORG,DVBNOW,DVBCOMP,DVBPT,DVBIEN,DVBCT,DVBFLAG,DVBDATE,DVBPATCH
  1. K ^TMP("CAPRI XML LIST",$J) S DVBNCT=""
  1. S DVBALL=1 I '$D(DVBDUZ) S DVBALL=0
  1. S DVBPATCH=3231025,DVBIEN=""
  1. S DVBDATE=DVBPATCH F S DVBDATE=$O(^DVB(396.17,"C",DVBDATE)) Q:DVBDATE="" D
  1. .S DVBIEN="" F S DVBIEN=$O(^DVB(396.17,"C",DVBDATE,DVBIEN)) Q:DVBIEN="" D
  1. ..I '$D(^DVB(396.17,DVBIEN,14,"B")) Q
  1. ..S DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I") I (DVBALL=1)&($G(DVBDUZ)'=DVBAUTH) Q
  1. ..S DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
  1. ..S DVBCT=0 F S DVBCT=$O(^DVB(396.17,DVBIEN,14,"B",DVBCT)) Q:DVBCT="" D
  1. ...S DVBFLAG=0,DVBINN=""_DVBCT_","_DVBIEN_","_""
  1. ...S DVBSTA=$$GET1^DIQ(396.1726,DVBINN,".02","I")
  1. ...I DVBSTA="C" Q
  1. ...S DVBORG=$$GET1^DIQ(396.1726,DVBINN,".05","I")
  1. ...S DVBNAME=$$GET1^DIQ(396.1726,DVBINN,".03","E")
  1. ...S DVBNOW=$$NOW^XLFDT S DVBDT=$$FMDIFF^XLFDT(DVBNOW,DVBORG,3)
  1. ...S DVBCOMP=$P(DVBDT," ",1) I DVBCOMP>=1 S DVBFLAG=1
  1. ...S DVBORG=$$FMTE^XLFDT(DVBORG,1)
  1. ...S DVBLIST=DVBIEN_U_DVBCT_U_DVBNAME_U_DVBPT_U_DVBORG_U_DVBFLAG_";"
  1. ...S DVBNCT=DVBNCT+1 M ^TMP("CAPRI XML LIST",$J,DVBNCT)=DVBLIST
  1. ...Q
  1. S DVBFAIL=$NA(^TMP("CAPRI XML LIST",$J))
  1. Q
  1. ;
  1. FAILXML(DVBXML,DVBIEN,DVBCT) ;
  1. N DVBABCNT,DVBFXML,DVNCT,DVBFXML,DVBABIEN K ^TMP("DVBAXML",$J)
  1. I '$D(^DVB(396.17,DVBIEN)) S DVBXML="0^NO RECORD EXISTS" Q
  1. I '$D(^DVB(396.17,DVBIEN,14,DVBCT)) S DVBXML="0^NO RECORD EXISTS" Q
  1. S DVBABCNT=1,DVBABIEN=0,DVNCT=0
  1. S DVBRTN=$$LOCK(DVBIEN,DVBCT) I DVBRTN=0 S DVBXML="1^LOCKED RECORD" Q
  1. F S DVBABIEN=$O(^DVB(396.17,DVBIEN,14,DVBCT,3,DVBABIEN)) Q:'DVBABIEN D
  1. .S DVBFXML=$G(^DVB(396.17,DVBIEN,14,DVBCT,3,DVBABCNT,0))
  1. .I DVBABCNT=1 S DVBFXML="1"_U_DVBFXML
  1. .S DVBABCNT=DVBABCNT+1,DVNCT=DVNCT+1 M ^TMP("DVBAXML",$J,DVNCT)=DVBFXML
  1. .Q
  1. S DVBXML=$NA(^TMP("DVBAXML",$J))
  1. D UNLOCK(DVBIEN,DVBCT)
  1. Q
  1. ;
  1. SAVEXML(DVBRTN,DVBNAME,DVBCT,DVBCNT,DVBXML,DVBSTAT,DVBRESP,DVBIEN) ;
  1. I $G(DVBCT)="" S DVBCT=1
  1. I $G(DVBCNT)="" S DVBCNT=1
  1. S DVBRESP="Initial Save"
  1. D STATUS(.DVBRTN,DVBIEN,DVBCT,DVBNAME,DVBSTAT,DVBRESP)
  1. D FILEIN(.DVBRTN,DVBIEN,DVBCT,DVBCNT,.DVBXML)
  1. K DIC,DIE,DA,DR,DLAYGO,X,Y
  1. S DVBRTN=DVBRTN
  1. Q
  1. FILEIN(DVBRTN,DVBIEN,DVBCT,DVBCNT,DVBXML) ;
  1. N DVBERR
  1. D WP^DIE(396.1726,DVBCT_","_DVBIEN_",",.04,"K","DVBXML","DVBERR")
  1. I $D(DVBERR) S DVBRTN=$G(DVBERR) Q
  1. S DVBRTN=DVBRTN
  1. Q
  1. STATUS(DVBRTN,DVBIEN,DVBCT,DVBNAME,DVBSTAT,DVBRESP) ;
  1. N DVBCNT,DVBDT,DVBNWIEN,DVBINN,DVBTRANS,DVBSTA
  1. S DVBSTA=$S(DVBSTAT=1:"C",1:"E")
  1. I '$D(DVBRESP)!(DVBRESP="")&(DVBSTA="C") S DVBRESP="TRANSMISSION COMPLETE"
  1. S DVBDT=$$NOW^XLFDT,DVBCNT=""
  1. S DVBCNT=$O(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT),-1)
  1. S DVBCNT=$G(DVBCNT)+1
  1. K DIC,DIE,DA,DR,DLAYGO,X,Y
  1. S DA(2)=DVBIEN,DA(1)=DVBCT,X=DVBCNT
  1. S (DLAYGO,DIC)="^DVB(396.17,"_DA(2)_",14,"_DA(1)_",10,",DIC(0)="L"
  1. D ^DIC
  1. S (DA,DVBNWIEN)=+Y
  1. S DIE=DIC
  1. S DR=".01////"_DVBNWIEN_";.02////"_DVBDT_";.03////"_DUZ_";.04////"_DVBRESP
  1. D ^DIE K DIE,DIC,DA,DR,DLAYGO,X,Y
  1. S DVBINN=""_DVBCT_","_DVBIEN_","_""
  1. S DVBTRANS=$$GET1^DIQ(396.1726,DVBINN,".07","I")
  1. I DVBRESP'="Initial Save" S DVBTRANS=$G(DVBTRANS)+1
  1. S DA(1)=DVBIEN,DA=DVBCT
  1. S (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",14,",DIC(0)="L"
  1. D ^DIC
  1. S DIE=DIC
  1. S DR=".01////"_DVBCT_";.07////"_DVBTRANS_";.02////"_DVBSTA
  1. D ^DIE
  1. I DVBSTA="C" S DR=".09////"_DVBDT D ^DIE
  1. I $G(DVBNAME)'="" S DR=".03////"_DVBNAME D ^DIE
  1. I DVBRESP="Initial Save" S DR=".05////"_DVBDT D ^DIE
  1. S DVBRTN=1 I $D(DIERR) S DVBRTN=0
  1. D UNLOCK(DVBIEN,DVBCT)
  1. K DIC,DIE,DIERR,DA,DR,DLAYGO,X
  1. Q
  1. ;
  1. LOCK(DVBIEN,DVBCT) ;
  1. L +^DVB(396.17,DVBIEN,14,DVBCT,3):30
  1. S DVBRTN=$T
  1. Q DVBRTN
  1. ;
  1. UNLOCK(DVBIEN,DVBCT) ;
  1. L -^DVB(396.17,DVBIEN,14,DVBCT,3)
  1. Q
  1. ;
  1. FAILCHK(DVBRTN) ;
  1. K DVBRTN S DVBRTN=0,DVBPATCH=3231025
  1. S DVBDATE=DVBPATCH F S DVBDATE=$O(^DVB(396.17,"C",DVBDATE)) Q:(DVBDATE="")!(DVBRTN=1) D
  1. .S DVBIEN="" F S DVBIEN=$O(^DVB(396.17,"C",DVBDATE,DVBIEN)) Q:(DVBIEN="")!(DVBRTN=1) D
  1. ..I $D(^DVB(396.17,DVBIEN,14,"B")) D
  1. ...S DVBCT=0 F S DVBCT=$O(^DVB(396.17,DVBIEN,14,"B",DVBCT)) Q:(DVBCT="")!(DVBRTN=1) D
  1. ....S DVBINN=""_DVBCT_","_DVBIEN_","_""
  1. ....S DVBSTA=$$GET1^DIQ(396.1726,DVBINN,".02","I")
  1. ....I DVBSTA'="C" S DVBRTN=1
  1. Q