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

DVBCPUSH.m

Go to the documentation of this file.
  1. DVBCPUSH ;ALB/AKG - CAPRI PUSH UTILITY RPC; APR 25, 2022@9:30am ; 5/19/23 9:07am
  1. ;;2.7;AMIE;**238,242,248**;Apr 10, 1995;Build 6
  1. ;Per VHA Directive 6402 this routine should not be modified
  1. ;ICR #2263 Supports all calls to Parameter File and XPAR usage
  1. ;
  1. Q
  1. ;
  1. PARAMS(DVBLIST) ;returns data on the entire DVBA parameter list
  1. ;rpc returns all CAPRI namespaced Paramaters
  1. K DVBLIST
  1. N DVBCNT,DVBPARAM,DVBVAL,DVBPAR
  1. S DVBCNT=0
  1. S DVBPARAM="" F S DVBPARAM=$O(^XTV(8989.51,"B",DVBPARAM)) Q:DVBPARAM="" D
  1. .S DVBPAR="" F S DVBPAR=$O(^XTV(8989.51,"B",DVBPARAM,DVBPAR)) Q:DVBPAR="" D
  1. ..I $P($P(DVBPARAM,U,1)," ")'["DVBA" Q
  1. ..S DVBVAL=$$GET^XPAR("PKG",DVBPARAM,1,"Q")
  1. ..S DVBLIST(DVBCNT)=DVBPAR_U_DVBPARAM_U_DVBVAL
  1. ..S DVBCNT=DVBCNT+1
  1. Q
  1. ;
  1. PARAMED(DVBMSG,DVBNAME,DVBVAL) ;
  1. ;edits exiting paramater value from CAPRI Push Utility
  1. I $G(DVBNAME)="" S DVBMSG="Missing parameter name" Q
  1. I $G(DVBVAL)="" S DVBMSG="Missing new value" Q
  1. K DVBMSG S DVBMSG=""
  1. N DVBERR,DVBINFO,DVBOLD
  1. S DVBOLD=$$GET^XPAR("PKG",DVBNAME,1,"Q")
  1. D EN^XPAR("PKG.AUTOMATED MED INFO EXCHANGE",DVBNAME,1,DVBVAL,.DVBERR)
  1. I DVBERR S DVBMSG="Failed to update because "_DVBERR_U_0 Q
  1. S DVBINFO=$$GET^XPAR("PKG",DVBNAME,1,"Q")
  1. S DVBMSG=DVBNAME_" value updated successfully from "_DVBOLD_" to "_DVBINFO_U_1
  1. Q
  1. ;
  1. PARADESC(DVBRTN,DVBIEN) ;
  1. ;returns description for selected parameter
  1. N DVBX,DVBTWP,DVBERR,DVBCT,DVBRT,DVBIENS,DVBTMP
  1. I $G(DVBIEN)="" S DVBRTN="Missing Parameter IEN" Q
  1. D GETS^DIQ(8989.51,DVBIEN,20,"","DVBTWP","DVBERR")
  1. I $D(DVBERR) S DVBRTN=DVBERR Q
  1. K DVBTMP M DVBTMP=DVBTWP
  1. S DVBIENS=""_DVBIEN_","
  1. I $D(DVBTMP) D
  1. .S DVBCT="",DVBX="" F S DVBX=$O(DVBTMP(8989.51,DVBIENS,20,DVBX)) Q:DVBX="" D
  1. ..S DVBCT=DVBCT+1
  1. ..S DVBRT(DVBCT)=DVBTMP(8989.51,DVBIENS,20,DVBX)
  1. M DVBRTN=DVBRT
  1. K DVBRT,DVBTWP
  1. Q
  1. ;
  1. EFOLDMET(DVBRTN,DVBAUTH,DVBPIEN,DVBTRANS,DVBSTAT,DVBERR,DVBRPD) ;
  1. ;Input: DVBAUTH=Authorized User IEN
  1. ; DVBPIEN=Patient IEN
  1. ; DVBTRANS=Transmission Path
  1. ; DVBSTAT=Transmission Status
  1. ; DVBERR=Transmission Error Code
  1. ; DVBRPD=Report Details
  1. ;Output: RTN=0 for Failure and 1 for Success
  1. ;
  1. N DVBDT,DIC,X,Y,DA,DTOUT,DUOUT,DLAYGO,DVBI,DVBRPC,DVBN1,DVBAIEN,DVBNUM
  1. I DVBAUTH="" S DVBRTN="0^MISSING AUTHORIZED USER IEN" Q
  1. I DVBPIEN="" S DVBRTN="0^MISSING PATIENT IEN" Q
  1. I DVBTRANS="" S DVBRTN="0^MISSING TRANSMISSION PATH" Q
  1. I DVBSTAT="" S DVBRTN="0^MISSING TRANSMISSION STATUS" Q
  1. S DVBDT=$$NOW^XLFDT()
  1. K DIC,DIE,DR,DA
  1. S (DIC,DIE)="^DVB(396.21,",DIC(0)="L",DLAYGO=396.21 S X=DVBDT
  1. D ^DIC S DA=+Y K DIC
  1. I DA=-1 S DVBRTN=0 Q
  1. S DVBRTN=1
  1. S DR=".02////"_DVBAUTH_";.03////"_DVBPIEN_";1////"_DVBTRANS D ^DIE
  1. S DR="1.1////"_DVBSTAT_";1.2////"_DVBERR D ^DIE
  1. S DVBNUM=DA
  1. S DVBI="" F S DVBI=$O(DVBRPD(DVBI)) Q:DVBI="" D
  1. .S DA(1)=DVBNUM
  1. .S DIC="^DVB(396.21,"_DA(1)_",2,",DIC(0)="L"
  1. .D ^DIC S DA=+Y
  1. .S DIE=DIC
  1. .S DVBRPC=$P(DVBRPD(DVBI),U),DVBAIEN=$P(DVBRPD(DVBI),U,2)
  1. .S DVBN1=$P(DVBRPD(DVBI),U,3,100)
  1. .S DR=".01////"_DVBRPC_";.02////"_DVBAIEN_";.03////"_DVBN1
  1. .D ^DIE
  1. K DIC,DIE,DA,DR,DIRUT
  1. Q
  1. ;
  1. PURGEMET(DVBRTN,DUZ,DVBDTP) ;
  1. ;
  1. ;input: DUZ user must have the DVBA METRICS DATA PURGE key
  1. ; : Date to purge up to
  1. N DVBDT,DVBDA,DVBKEY,DVBDATE
  1. I DUZ="" S DVBRTN="0^Missing DUZ" Q
  1. I DVBDTP="" S DVBRTN="0^Missing Date" Q
  1. S X=DVBDTP D ^%DT S DVBDATE=Y
  1. D OWNSKEY^XUSRB(.DVBKEY,"DVBA CAPRI METRICS PURGE",DUZ)
  1. I DVBKEY(0)=0 S DVBRTN="0^Missing security key" Q
  1. S DVBDT="" F S DVBDT=$O(^DVB(396.21,"B",DVBDT)) Q:DVBDT="" D
  1. .S DVBDA="" F S DVBDA=$O(^DVB(396.21,"B",DVBDT,DVBDA)) Q:DVBDA="" D
  1. ..I $P(DVBDT,".")>DVBDATE Q
  1. ..K DIC,DA,DIK
  1. ..S DIC="^DVB(396.21,",DA=DVBDA
  1. ..S DIK=DIC D ^DIK K DIK,DIC
  1. ..S DVBRTN=1
  1. I $G(DVBRTN)'=1 S DVBRTN="-1"
  1. Q
  1. PURGEOPT ;
  1. W !!,"CAPRI CLINICAL DOCUMENTS EFOLDER METRIC DATA PURGE",!!
  1. S DIR("?")="Enter date to purge CAPRI Clinical Documents EFolder Metrics file up to. For Example,to purge from today and older enter today's date"
  1. S DIR("A")="Enter date to purge CAPRI Clinical Documents EFolder Metrics file."
  1. S DIR(0)="D" D ^DIR K DIR Q:$D(DIRUT)!($D(DTOUT))
  1. D PURGEMET(.DVBRTN,DUZ,Y)
  1. I DVBRTN["Miss" W !!,"Missing Security Key, please check with your manager for additional assistance" Q
  1. I DVBRTN'=1 W !!,"No records were purged",!! D PURGEOPT Q
  1. I DVBRTN=1 W !!,"Purge completed"
  1. Q
  1. ALL(DVBLIST) ;
  1. K DVBLIST
  1. N DVBCNT,DVBPARAM,DVBVAL,DVBPAR,DVBSIY,DVBSIEN,DVBZ,DVBERR
  1. S DVBCNT=0
  1. S DVBPARAM="" F S DVBPARAM=$O(^XTV(8989.51,"B",DVBPARAM)) Q:DVBPARAM="" D
  1. .S DVBPAR="" F S DVBPAR=$O(^XTV(8989.51,"B",DVBPARAM,DVBPAR)) Q:DVBPAR="" D
  1. ..S DVBZ="30*" K DVBSIY D GETS^DIQ(8989.51,DVBPAR,DVBZ,"I","DVBSIY","DVBERR") I $D(DVBERR) Q
  1. ..S DVBSIEN="" F S DVBSIEN=$O(DVBSIY(8989.513,DVBSIEN)) Q:DVBSIEN="" D
  1. ...N DVBENT S DVBENT=DVBSIY(8989.513,DVBSIEN,.02,"I") I DVBENT'=9.4 Q
  1. ...I DVBPARAM["XPAR" Q
  1. ...S DVBVAL=$$GET^XPAR("ALL",DVBPARAM,1,"Q")
  1. ...S DVBLIST(DVBCNT)=DVBPARAM_U_DVBVAL
  1. ...S DVBCNT=DVBCNT+1
  1. Q
  1. SPECADD(DVBMSG,DVBNAME) ;
  1. ;adds entry to Special Considerations
  1. I $G(DVBNAME)="" S DVBMSG="0^Missing Special Considerations name" Q
  1. K DVBMSG S DVBMSG="",DVBIEN=0
  1. F S DVBIEN=$O(^DVB(396.25,DVBIEN)) Q:DVBIEN=""!('DVBIEN) D
  1. .I $P(^DVB(396.25,DVBIEN,0),U,1)=DVBNAME S DVBMSG="0^Duplicate"
  1. .Q
  1. I DVBMSG="" D
  1. .K DIC,DO,DIE,DA,DR,DLAYGO,X,Y
  1. .N DIERR
  1. .S DIC=396.25,DIC(0)="Z",X=DVBNAME D FILE^DICN
  1. .S (DA)=+Y,DIE=DIC
  1. .S DR=".02////1" D ^DIE
  1. .I $D(DIERR) S DVBMSG="0^Record not added"
  1. .I '$D(DIERR) S DVBMSG="1^Record added"
  1. .K DIC,DO,DIE,DA,DR,DLAYGO,X,Y
  1. .Q
  1. Q
  1. SPECDIS(DVBMSG,DVBIEN,DVBSTAT) ;
  1. ;disables entry in Special Considerations
  1. N DIERR
  1. K DIC,DIE,DA,DR,DLAYGO,X,Y
  1. I $G(DVBIEN)="" S DVBMSG="0^Missing IEN" Q
  1. I $G(DVBSTAT)="" S DVBMSG="0^Missing Status" Q
  1. S DA=DVBIEN,(DLAYGO,DIE)="^DVB(396.25,",DIC(0)="L"
  1. S DR=".02////"_DVBSTAT D ^DIE
  1. I $D(DIERR) S DVBMSG="0^Record not disabled"
  1. I '$D(DIERR) S DVBMSG="1^Record disabled"
  1. K DIC,DIE,DA,DR,DLAYGO,X,Y
  1. Q
  1. LISTSC(DVBMSG) ;
  1. ;list inactive Special Considerations
  1. N DVBIEN,DVBCNT,DVBRET
  1. K ^TMP("DVBLSTSC",$J)
  1. S DVBIEN=0,DVBCNT=0
  1. F S DVBIEN=$O(^DVB(396.25,DVBIEN)) Q:DVBIEN=""!('DVBIEN) D
  1. .Q:$G(^DVB(396.25,DVBIEN,0))=""
  1. .Q:$P($G(^DVB(396.25,DVBIEN,0)),U,2)'=0
  1. .S DVBRET(DVBCNT)=$P(^DVB(396.25,DVBIEN,0),"^",1)_"^"_DVBIEN
  1. .M ^TMP("DVBLSTSC",$J,DVBCNT)=DVBRET(DVBCNT)
  1. .S DVBCNT=DVBCNT+1
  1. S DVBMSG=$NA(^TMP("DVBLSTSC",$J))
  1. Q