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

DVBCTPD2.m

Go to the documentation of this file. 
  1. DVBCTPD2 ;ALB/BG/JD/CP - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 10/4/23 10:07am
  1.  ;;2.7;AMIE;**250,252**;Apr 10, 1995;Build 92
  1.  ; Per VHA Directive 6402 this routine should not be modified
  1.  ; Reference to $$NOW^XLFDT and $$FMTE^XLFDT in ICR #10103
  1.  Q
  1.  ;
  1. TRANSRPT(DVBRTN,DVBIEN,DVBSDT,DVBEDT) ;
  1.  K ^TMP("CAPRI TRANSRPT",$J) S DVBCNNT=""
  1.  I DVBIEN'="" D 
  1.  .S DVBCT=0 F  S DVBCT=$O(^DVB(396.17,DVBIEN,14,"B",DVBCT)) Q:DVBCT=""  D
  1.  ..S DVBINN1=""_DVBCT_","_DVBIEN_","_""
  1.  ..S DVBSTA=$$GET1^DIQ(396.1726,DVBINN1,".02","E")
  1.  ..S DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","I")
  1.  ..;;Updating for name w/o version CPARI-9567 CP 05/14/24
  1.  ..I DVBNAME["_" S DVBNAME=$$NAMEUPD(DVBNAME)
  1.  ..I DVBNAME?.N S DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","E")
  1.  ..S DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
  1.  ..S DVBCNT=0 F  S DVBCNT=$O(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT)) Q:DVBCNT=""  D
  1.  ...S DVBINN2=""_DVBCNT_","_DVBCT_","_DVBIEN_","_""
  1.  ...S DVBAUTH=$$GET1^DIQ(396.2026,DVBINN2,".03","E")
  1.  ...S DVBTRDT=$$GET1^DIQ(396.2026,DVBINN2,".02","E")
  1.  ...S DVBRESP=$$GET1^DIQ(396.2026,DVBINN2,".04","E")
  1.  ...S DVBCNNT=DVBCNNT+1 S ^TMP("CAPRI TRANSRPT",$J,DVBNAME,DVBTRDT,DVBCNNT)=DVBNAME_U_DVBPT_U_DVBAUTH_U_DVBTRDT_U_DVBSTA_U_DVBRESP
  1.  ...Q
  1.  .S DVBRTN=$NA(^TMP("CAPRI TRANSRPT",$J))
  1.  .Q
  1.  ;;
  1.  I DVBIEN="" D
  1.  .S DVBDT=$$NOW^XLFDT
  1.  .I DVBSDT="",DVBEDT="" S DVBRTN="-1^MISSING DATE RANGE" Q
  1.  .S X=$G(DVBSDT) D ^%DT S DVBSDT=Y
  1.  .I DVBEDT'="" S X=DVBEDT D ^%DT S DVBEDT=Y
  1.  .I DVBEDT="" S DVBEDT=$P(DVBDT,".",1)
  1.  .S DVBIEN=0 F  S DVBIEN=$O(^DVB(396.17,DVBIEN)) Q:DVBIEN=""  D
  1.  ..S DVBCT=0 F  S DVBCT=$O(^DVB(396.17,DVBIEN,14,"B",DVBCT)) Q:DVBCT=""  D
  1.  ...S DVBINN1=""_DVBCT_","_DVBIEN_","_""
  1.  ...S DVBCNT=0 F  S DVBCNT=$O(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT)) Q:DVBCNT=""  D
  1.  ....S DVBINN2=""_DVBCNT_","_DVBCT_","_DVBIEN_","_""
  1.  ....S DVBCHKDT=$$GET1^DIQ(396.2026,DVBINN2,".02","I")
  1.  ....S DVBCHKDT=$P(DVBCHKDT,".",1)
  1.  ....I DVBCHKDT<DVBSDT Q
  1.  ....I DVBCHKDT>DVBEDT Q 
  1.  ....S DVBTRDT=$$GET1^DIQ(396.2026,DVBINN2,".02","E")
  1.  ....S DVBSTA=$$GET1^DIQ(396.1726,DVBINN1,".02","E")
  1.  ....S DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","I")
  1.  ....;;Updating for name w/o version CPARI-9567 CP 05/14/24
  1.  ....I DVBNAME["_" S DVBNAME=$$NAMEUPD(DVBNAME)
  1.  ....I DVBNAME?.N S DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","E")
  1.  ....S DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
  1.  ....S DVBAUTH=$$GET1^DIQ(396.2026,DVBINN2,".03","E")
  1.  ....S DVBRESP=$$GET1^DIQ(396.2026,DVBINN2,".04","E")
  1.  ....S DVBCNNT=DVBCNNT+1 S ^TMP("CAPRI TRANSRPT",$J,DVBNAME,DVBTRDT,DVBCNNT)=DVBNAME_U_DVBPT_U_DVBAUTH_U_DVBTRDT_U_DVBSTA_U_DVBRESP
  1.  ....Q
  1.  .S DVBRTN=$NA(^TMP("CAPRI TRANSRPT",$J))
  1.  .Q
  1.  K DVBCNNT,X,Y,DVBCT,DVBINN1,DVBSTA,DVBNAME,DVBPT,DVBCNT,DVBINN2,DVBAUTH,DVBTRDT,DVBRESP,DVBCHKDT,DVBDT
  1.  Q
  1. ADDPDF(DVBRTN,DVBIEN,DVBEXAMNAME) ;
  1.  ;Adding an exam to an existing worksheet CAPRI-9010 CP
  1.  N DVBERR,DVBEXAMSEQ,DVBI,DVBNEWSEQ,DVBFORM,DVBDTTM,DVBPREV,DVBRTFG,DVBEN2,DVBPN2
  1.  S (DVBEXAMSEQ,DVBI,DVBNEWSEQ,DVBDTTM,DVBFORM,DVBPREV,DVBRTFG)=""
  1.  S DVBPREVSEQ=$P($G(^DVB(396.17,DVBIEN,1,0),""),U,3)
  1.  S DVBFORM=$G(^DVB(396.17,DVBIEN,4))
  1.  F DVBI=1:1:DVBPREVSEQ D 
  1.  . S DVBPREV=$G(^DVB(396.17,DVBIEN,1,DVBI,0))
  1.  .;;Updates for version numbers CAPRI-10405 CP 
  1.  . S DVBPN2=$P(DVBPREV,U,2)
  1.  . S DVBPN2=$$NAMEUPD(DVBPN2)
  1.  . S DVBEN2=$$NAMEUPD(DVBEXAMNAME)
  1.  . I ("*DEL*"_DVBEN2)=DVBPN2 D 
  1.  . . S $P(DVBPREV,U,2)=DVBEXAMNAME
  1.  . . S DVBEXAMSEQ(DVBI)=DVBPREV,DVBRTFG=DVBIEN_U_$P(DVBPREV,U,2)_U_$P(DVBPREV,U,1)
  1.  . . Q 
  1.  . I $D(DVBEXAMSEQ(DVBI))=1 Q
  1.  . S DVBEXAMSEQ(DVBI)=$G(^DVB(396.17,DVBIEN,1,DVBI,0))
  1.  I DVBRTFG="" D 
  1.  . S DVBNEWSEQ=DVBPREVSEQ+1
  1.  . S DVBEXAMSEQ(DVBNEWSEQ)=DVBNEWSEQ_"^"_DVBEXAMNAME_"^0"
  1.  . K DIC,DIE,DA,DR,DLAYGO,X,Y
  1.  . S DA(1)=DVBIEN,(DA,X)=DVBPREVSEQ
  1.  . S (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",1,",DIC(0)="LZ"
  1.  . D ^DIC
  1.  I DVBRTFG="" S DVBRTN=DVBIEN_U_DVBEXAMNAME_U_DVBNEWSEQ
  1.  I DVBRTFG'="" S DVBRTN=DVBRTFG_U_"Exam has been Restored"
  1.  D WP^DIE(396.17,DVBIEN_",",6,"K","DVBEXAMSEQ","DVBERR")
  1.  I $D(DVBERR) S DVBRTN="-1^Data Not Saved" Q 
  1.  K DIC,DIE,DA,DR,DLAYGO,X,Y
  1.  S DVBDTTM=$$NOW^XLFDT
  1.  S DA=DVBIEN,DIE=396.17
  1.  S DR="4///"_DVBDTTM
  1.  I DVBFORM'="MERGED FORM" S DR=DR_";9///MERGED FORM"
  1.  D ^DIE
  1.  K DIC,DIE,DA,DR,DLAYGO,X,Y
  1.  K DVBPREVSEQ
  1.  Q
  1. DELETEXAM(DVBRTN,DVBIEN,DVBSEQ,DVBEXAMNAME) ;
  1.  ;Deleting an exam from Worksheet CAPRI-9010 CP
  1.  N DVBERR,DVBEXAMSEQ,DVBI,DVBNEWSEQ,DVBDTTM,DVBCNT,DVBFORM
  1.  S DVBCNT=0
  1.  S DVBCUR=$G(^DVB(396.17,DVBIEN,1,DVBSEQ,0),"")
  1.  I $P(DVBCUR,U,2)'=DVBEXAMNAME S DVBRTN="-1^Exam Names do not match" Q
  1.  S DVBPREVSEQ=$P($G(^DVB(396.17,DVBIEN,1,0),""),U,3)
  1.  F DVBI=1:1:DVBPREVSEQ D 
  1.  . I DVBI=DVBSEQ D
  1.  . . S DVBNAME=$P($G(^DVB(396.17,DVBIEN,1,DVBI,0)),U,2)
  1.  . . S DVBSAVE=$P($G(^DVB(396.17,DVBIEN,1,DVBI,0)),U,3)
  1.  . . S DVBEXAMSEQ(DVBI)=DVBI_U_"*DEL*"_DVBNAME_U_DVBSAVE
  1.  . I DVBI'=DVBSEQ S DVBEXAMSEQ(DVBI)=$G(^DVB(396.17,DVBIEN,1,DVBI,0))
  1.  D WP^DIE(396.17,DVBIEN_",",6,"K","DVBEXAMSEQ","DVBERR")
  1.  I $D(DVBERR) S DVBRTN="-1^Data Not Saved" Q
  1.  I $D(DVBERR)=0 S DVBRTN="1"
  1.  K DIC,DIE,DA,DR,DLAYGO,X,Y
  1.  F DVBI=1:1:DVBPREVSEQ D
  1.  . I $G(^DVB(396.17,DVBIEN,1,DVBI,0))["*DEL*" Q
  1.  . I $G(^DVB(396.17,DVBIEN,1,DVBI,0))'["*DEL*" D 
  1.  . . S DVBCNT=DVBCNT+1
  1.  . . S DVBFORM=$P($G(^DVB(396.17,DVBIEN,1,DVBI,0)),U,2)
  1.  S DVBDTTM=$$NOW^XLFDT
  1.  S DA=DVBIEN,DIE=396.17
  1.  S DR="4///"_DVBDTTM
  1.  I DVBCNT=1 S DR=DR_";9///"_DVBFORM
  1.  D ^DIE
  1.  K DIC,DIE,DA,DR,DLAYGO,X,Y
  1.  K DVBCUR,DVBPREVSEQ
  1.  Q
  1. EXAMHIST(DVBRTN,DVBIEN) ;Exam history - CAPRI-9413.  JD - 4/3/24
  1.  ;Returns the exam history for a given worksheet
  1.  ;
  1.  ;Corresponding RPC: DVBA CAPRI GET EXAM HISTORY
  1.  ;
  1.  ;Updating return details to include save message, version, and user CAPRI-11245 CP 6/21/24 
  1.  I DVBIEN="" S DVBRTN="-1^No worksheet IEN was provided" Q
  1.  I '$D(^DVB(396.17,DVBIEN,0)) S DVBRTN="-1^Worksheet IEN="_DVBIEN_" does not exist" Q
  1.  K ^TMP("DVBAEXAMHIST",$J)
  1.  N DVBCNT,DVBEXNM,DVBEXSQ,DVBEXSV,DVBEXSVDT,DVBSMSG,DVBVER,DVBUSER
  1.  S (DVBCNT,DVBEXNM,DVBEXSQ,DVBEXSVDT,DVBSMSG,DVBVER,DVBUSER)=""
  1.  F  S DVBEXSQ=$O(^DVB(396.17,DVBIEN,15,"B",DVBEXSQ)) Q:DVBEXSQ=""  D
  1.  . S DVBEXSV="",DVBEXNM=$P($G(^DVB(396.17,DVBIEN,1,DVBEXSQ,0)),U,2)
  1.  . F  S DVBEXSV=$O(^DVB(396.17,DVBIEN,15,"B",DVBEXSQ,DVBEXSV)) Q:DVBEXSV=""  D
  1.  . . S DVBEXSVDT=$P($G(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U),DVBCNT=DVBCNT+1
  1.  . . S DVBEXSVDT=$$FMTE^XLFDT(DVBEXSVDT)
  1.  . . I $P(DVBEXSVDT,":",3)="" S DVBEXSVDT=DVBEXSVDT_":00"
  1.  . . S DVBSMSG=$P($P($G(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U,3),"|",2)
  1.  . . S DVBVER=$P($P($G(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U,3),"|",3)
  1.  . . S DVBUSER=$P($P($G(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U,3),"|",4)
  1.  . . S DVBUSER=$$GET1^DIQ(200,DVBUSER,".01","E")
  1.  . . S ^TMP("DVBAEXAMHIST",$J,DVBCNT)=DVBEXSQ_U_DVBEXNM_U_DVBEXSV_U_DVBEXSVDT_U_DVBSMSG_U_DVBVER_U_DVBUSER
  1.  I DVBCNT'>0 S DVBRTN="-1^Worksheet IEN="_DVBIEN_" has no exam history" Q
  1.  S DVBRTN=$NA(^TMP("DVBAEXAMHIST",$J))
  1.  Q
  1. RESTORE(DVBRTN,DVBIEN,DVBSEQ,DVBEXAM,DVBSAVE,DVBDATE) ;
  1.  ;Restoring an exam from Worksheet History CAPRI-9010 CP
  1.  N DVBERR,DVBTAB,DVBPDFDATA,DVBTOT,DVBI,DVBARTN,DVBEXAM2,DVBDTM,%DT,DVBMESS,DVBEXNMX,DVBDATA1,DVBTEXT1,DVBDATA2,DVBTEXT2,DVBSMSG,DVBVER,DVBTM
  1.  S (DVBERR,DVBTAB,DVBTOT,DVBI,DVBARTN,DVBDTM,DVBSMSG,DVBVER)=""
  1.  ;
  1.  S DVBMESS=$S(DVBIEN="":"Worksheet IEN",DVBSEQ="":"Exam Seq",DVBEXAM="":"Exam Name",DVBSAVE="":"Save Seq",DVBDATE="":"Save DateTime",1:"")
  1.  I DVBMESS'="" S DVBRTN="-1^Missing "_DVBMESS Q
  1.  S X=$P(DVBDATE,"@",1),%DT="" D ^%DT S DVBDTM=Y
  1.  I DVBDTM="-1" S DVBRTN="-1^Invalid DateTime Format:" Q
  1.  K %DT
  1.  ;
  1.  ;;Correcting for saved time format CAPRI-13217 CP 8-28-24
  1.  S DVBTM=$TR($P(DVBDATE,"@",2),":")
  1.  I $E(DVBTM,5,6)="00" S DVBTM=$E(DVBTM,1,4)
  1.  I $E(DVBTM,6)=0 S DVBTM=$E(DVBTM,1,5)
  1.  ;
  1.  ;;Updates for version numbers CAPRI-10405 CP
  1.  S DVBEXNMX=$$NAMEUPD(DVBEXAM)
  1.  S DVBARTN=""
  1.  S DVBDATA1=$P($G(^DVB(396.17,DVBIEN,1,DVBSEQ,0)),U,1,2)
  1.  S DVBDATA1=$$NAMEUPD(DVBDATA1)
  1.  S DVBTEXT1=DVBSEQ_U_DVBEXNMX
  1.  I DVBDATA1'=DVBTEXT1 S DVBRTN="-1^Incorrect Exam Name and Seq Number" Q
  1.  I DVBEXAM["*DEL*" S DVBEXAM2=$P(DVBEXAM,"*",3) D ADDPDF(.DVBARTN,DVBIEN,DVBEXAM2)
  1.  I DVBARTN["-1^" S DVBRTN=DVBARTN Q
  1.  I DVBARTN'="" S DVBEXAM=$P(DVBARTN,U,2),DVBEXNMX=$$NAMEUPD(DVBEXAM)
  1.  S DVBDTM=DVBDTM_"."_DVBTM
  1.  ;;Updating for correct pull of date/time and exam name CAPRI-13217 CP 8-28-24
  1.  S DVBDATA2=$P($G(^DVB(396.17,DVBIEN,15,DVBSAVE,1)),U,1,2)
  1.  S DVBDATA2=$$NAMEUPD(DVBDATA2)
  1.  S DVBTEXT2=DVBDTM_U_DVBEXNMX
  1.  I DVBDATA2'=DVBTEXT2 S DVBRTN="-1^Worksheet IEN/Save Seq do not match Save DateTime and Exam Name" Q
  1.  ;;CAPRI-11245 CP 6/21/24
  1.  S DVBTAB=$P($P($G(^DVB(396.17,DVBIEN,15,DVBSAVE,1),""),U,3),"|",1)
  1.  S DVBSMSG="RESTORE"
  1.  S DVBVER=$P($P($G(^DVB(396.17,DVBIEN,15,DVBSAVE,1),""),U,3),"|",3)
  1.  ;
  1.  S DVBPDFDATA=""
  1.  S DVBTOT=$P($G(^DVB(396.17,DVBIEN,15,DVBSAVE,2,0),""),U,3)
  1.  I DVBTOT'?.N S DVBRTN="-1^Error with PDF Data" Q
  1.  F DVBI=1:1:DVBTOT S DVBPDFDATA(DVBI)=$G(^DVB(396.17,DVBIEN,15,DVBSAVE,2,DVBI,0))
  1.  ;
  1.  D PDFSAVE^DVBCTPDF(.DVBERR,DVBIEN,DVBSEQ,DVBEXAM,.DVBPDFDATA,DVBTAB,DVBSMSG,DVBVER)
  1.  S DVBRTN=DVBERR Q
  1.  ;
  1.  Q
  1. NAMEUPD(DVBEXAM) ;
  1.  N DVBCNT,DVBEND,DVBEXNM2
  1.  S DVBCNT=$L(DVBEXAM,"_")
  1.  S DVBEND=DVBCNT-1
  1.  I DVBEND=0 Q DVBEXAM
  1.  S DVBEXNM2=$P(DVBEXAM,"_",1,DVBEND)
  1.  I DVBEXNM2="" S DVBEXNM2=DVBEXAM
  1.  Q DVBEXNM2