DGBTE1 ;ALB/SCK/GAH,LAB - BENEFICIARY TRAVEL FIND OLD CLAIM DATES ; 03/20/2019
;;1.0;Beneficiary Travel;**8,12,13,20,21,22,25,28,33,34,37,39**;September 25, 2001;Build 6
DATE ; get date for claim, either new or past date
N DGBTDCLM
K ^TMP("DGBT",$J),^TMP("DGBTARA",$J),DIR
I 'DGBTNEW S DIR("A",2)="Enter a 'P' to display Past CLAIM dates for editing."
S DIR("A",3)="Time is required when adding a new CLAIM.",DIR("A",4)="",DIR("A",1)="",DIR("A")="Select TRAVEL CLAIM DATE/TIME",DIR("?")="^D HELP^DGBTE1A"
S DIR(0)="F",DIR("B")="NOW" D ^DIR K DIR G ERR1:$D(DIRUT)
S CHZFLG=0,%DT="EXR",DTSUB=$S(Y="N":"NOW",Y="P":"OLD",Y="p":"OLD",1:"OTHR")_"^DGBTE1A" D @DTSUB ;PAVEL - DGBT*1*20
S:$P(DTSUB,U,1)="OLD"&(Y1>0) DGBTOLD=1 K DTSUB ;PAVEL DGBT*1*20
G ERR1:$D(DTOUT),DATE:Y1<0 S DGBTA=Y1 G SET:CHZFLG ;PAVEL DGBT*1*20
DATE1 ; for past claims, set DGBTDT to inverse date of claim date
I $D(^DGBT(392,"C",DFN)) D
. S DGBTC=0,DGBTDT=9999999-$E(DGBTA,1,7) ; set past claims counter=0
. ; for latest date (topmost) search for past claims
. F I=DGBTDT:0 S I=$O(^DGBT(392,"AI",DFN,I)) Q:'I!(I>(DGBTDT_.99999)) S DGBTC=DGBTC+1,DGBT(DGBTC)=9999999.99999-I
I '$D(DGBT) G LOCK
W !!,"There are other claims on this date.",!,"Select by number to edit or <RETURN> to add a new CLAIM.",!
; convert inverse claim date to external format through VADATE conversion routine
F I=0:0 S I=$O(DGBT(I)) Q:'I D
.S DGBTDCLM=$$GET1^DIQ(392,DGBT(I),45,"I")
.S VADAT("W")=DGBT(I) D ^VADATE W !?5,I,".",?10,VADATE("E")_$S($G(DGBTDCLM)'="":" (D)",1:"")
K DIR S DIR("A")="Select 1"_$S(DGBTC=1:"",1:"-"_DGBTC)_", or <RETURN> to add a new claim: ",DIR(0)="NOA^1:"_DGBTC,DIR("?")="Select, by number, one of the displayed claim dates: "
D ^DIR K DIR S:$G(Y) CHZFLG=1 G QUIT^DGBTEND:$D(DTOUT)!($D(DUOUT))
G LOCK:Y="" G DATE:'$D(DGBT(Y))
S DGBTA=DGBT(Y),DGBTOLD=1 G SET
LOCK ;
;L +^DGBT(392,DGBTA):$G(DILOCKTM,3)
;I '$T!$D(^DGBT(392,DGBTA)) L -^DGBT(392,DGBTA) S DGBTA=$$FMADD^XLFDT(DGBTA,,,,1) G LOCK ;dbe patch DGBT*1*21
;dgbt*1.0*33 - more efficient lookup
F Q:'$D(^DGBT(392,DGBTA)) S DGBTA=$$FMADD^XLFDT(DGBTA,,,,1)
L +^DGBT(392,DGBTA):$G(DILOCKTM,3) E S DGBTA=$$FMADD^XLFDT(DGBTA,,,,1) G LOCK ;dgbt*1.0*34 - added to increment if lock exists for record # that has not been created yet
S (DGBTDT,VADAT("W"))=DGBTA D ^VADATE W VADATE("E") ;for CCR235 by RE
ASKADD ;
W !!,"Are you sure you want to add a new claim"
S %=1 D YN^DICN I (%<0)!(%=2) L -^DGBT(392,DGBTA) G EXIT2^DGBTE ;dgbt*1.0*34 - unlock record immediately if user chooses no or exits
I '% W !!,"Enter 'YES' to add a new claim, or 'NO' not to add the claim." G ASKADD
K DD,DO
; create new file entry, stuff patient DFN into name field(pointer)
;DGBT*1.0*37 replace 4 slashes with ///, 2///' - ' allows for internal value to be validated and pushed in.
S (X,DINUM)=DGBTA,DIC="^DGBT(392,",DIC(0)="L",DIC("DR")="2///`"_DFN
D FILE^DICN K DIC L -^DGBT(392,DGBTA)
; go back to patient if no file entry
G:Y'>0 PATIENT^DGBTE
SET ; call inhouse generic date routine
S (DA,DGBTDT,VADAT("W"))=DGBTA D ^VADATE
; get internal and external formats of converted inverse dates
S DGBTDTI=$S($G(VADAT("W"))'="":VADAT("W"),1:VADATE("I")),DGBTDTE=VADATE("E") K VADAT,VADATE,DIC,Y
I $G(DGBTDIVI)'="" S DGBTDIVN=$P(^DG(40.8,DGBTDIVI,0),"^",7)
D GA^DGBTUTL(DFN,"DGBTINCA",DGBTDTI) ;Get Alternate Income PAVEL
STUFF ; stuff departure with address data from patient file, dest from institution file
S DGBTCMTY=$$GET1^DIQ(392,DGBTDT,56)
S:'$L(DGBTCMTY) DGBTCMTY="M"
D RESADDR^DGBTUTL1(.DGBTADDR) ;*39 - get values for address
;dbe patch DGBT*1*25 - removed restrictions below to allow departure and destination fields to get filed for existing claims
S:'$D(^DGBT(392,DGBTDT,"D")) ^DGBT(392,DGBTDT,"D")=DGBTADDR(1)_"^"_DGBTADDR(2)_"^"_DGBTADDR(3)_"^"_DGBTADDR(4)_"^"_$S(DGBTADDR(5)]"":+DGBTADDR(5),1:"")_"^"_$P(DGBTADDR(6),U) ;*39 - updated to use residential address
I '$D(^DGBT(392,DGBTDT,"T")) D
. S X=$S($D(^DIC(4,DGBTDIVN,1)):^(1),1:"")
. S ^DGBT(392,DGBTDT,"T")=($P(^DG(40.8,DGBTDIVI,0),U)_"^"_$P(X,U)_"^"_$P(X,U,2)_"^"_$P(X,U,3)_"^"_$P(^DIC(4,DGBTDIVN,0),U,2)_"^"_$TR($P(X,U,4),"-","")) ;*28 remove hyphen from zip code
Q:$G(DGBTSP2M) ;dbe patch DGBT*1*25 - added quit when called from routine dgbtee
CHKFILES ; section removed, dependents picked up below in MEANS ; abr 10/94
MEANS ; find corres. means test entry, gets MT income, status, no. of dependents
;DGBTMTS= MT Status; DGBTCSC= claim Service Connected indicator & %; DGBTELG=Eligibility status
N X,X2,X3,Y,DGBTIFL
S X=$$LST^DGMTCOU1(DFN,DT,3),DGBTMTS=$P(X,U,4)_U_$P(X,U,3) ; returns corres. MT info,X=IEN of last MT. passing a 3 will check both MT and RX Co-Pays
; get income, # dependents
S Y=$$INCOME^VAFMON(DFN,DGBTA,1)
S:"I^V"[$P(Y,U,2) Y=U ;If income type is I or V ignore it PAVEL
S:DGBTINCA Y=$P(DGBTINCA,U,2)_U_$E($P(DGBTINCA,U,4)) ;Set Alternate Income
S X=$P(Y,U),DGBTIFL=$P(Y,U,2) ; returns income & source.
I X?1N.E!(X<0) D
.I X<0 S X=0
.S X2="0$",X3=8 D COMMA^%DTC
S DGBTINC=X_U_$G(DGBTIFL) K X,X2
S DGBTDEP=$$DEP^VAFMON(DFN,DGBTA) ; finds dependents Vet, Spouse, Children
S DGBTDTY=" (Year: "_$$FMTE^XLFDT($E(DGBTDTI,1,3)_"0000")_")" ;Year to be displayed with Income
S DGBTMTTH=$$MTTH^DGBTMTTH(DGBTDEP,DGBTDTI) ; Means test threshold
S DGBTRXTH=+$$THRES^IBARXEU1(DGBTDTI,1,DGBTDEP) ; RX co-pay threshold
S DGBTDYFL=$$DAYFLAG^DGBTUTL ; valid income test y/n
;
PREV ; if past claim get SC%, elig.
I CHZFLG S X=^DGBT(392,DGBTA,0),DGBTELG=$P(X,U,3),DGBTCSC=$P(X,U,4) D
. S:$P(X,U,11) DGBTDIVI=+$P(X,U,11),DGBTDIVN=$P($G(^DG(40.8,DGBTDIVI,0)),U,7) ;dbe patch DGBT*1*22 - save division of existing claims
. S:DGBTCSC DGBTCSC=1_U_DGBTCSC S:'DGBTCSC DGBTCSC=0
. S:DGBTELG DGBTELG=DGBTELG_U_$P(^DIC(8,DGBTELG,0),U)
CERT ; get last BT certification, get date, then get eligibility
I $D(^DGBT(392.2,"C",DFN)) D
.;cd=cert date in inverse then external format, ce= eligibility, ca* = amt certified
. S DGBTCD=$O(^DGBT(392.2,"C",DFN,0)),DGBTCE=$P(^DGBT(392.2,DGBTCD,0),"^",3)
. S DGBTCA=$P(^DGBT(392.2,DGBTCD,0),"^",4),Y=9999999-$P(DGBTCD,".")
. X ^DD("DD") ; date conversion, y=cert date (internal)
. S DGBTCD=Y,X=DGBTCA,X2="0$",X3=8 K Y D COMMA^%DTC S DGBTCA=X K X,X2,X3
APPTS ; search patient file for appointments through claim date (DTI+1), add dates to array DGBTCL
N ERRCODE,DGARRAY,CLIEN,APTDT S DGARRAY("FLDS")="2;3;10;18"
S DGARRAY(4)=DFN,I=$$SDAPI^SDAMA301(.DGARRAY)
; I<0 = Error, I<0 = # of Records retrieved
I I<0 S ERRCODE=$O(^TMP($J,"SDAMA301","")),I1=1,DGBTCL("ERROR")=^TMP($J,"SDAMA301",ERRCODE)
I I>0 D
.S CLIEN=""
.F S CLIEN=$O(^TMP($J,"SDAMA301",DFN,CLIEN)) Q:'CLIEN D
..S APTDT=DGBTDTI\1
..F S APTDT=$O(^TMP($J,"SDAMA301",DFN,CLIEN,APTDT)) Q:'APTDT!(APTDT>(DGBTDTI+1)) D
...S SDATA=^TMP($J,"SDAMA301",DFN,CLIEN,APTDT)
...S DGBTCL(APTDT)=$P($P(^TMP($J,"SDAMA301",DFN,CLIEN,APTDT),U,2),";",2)_U_$P($P(SDATA,U,3),";")
...S DGBTCL(APTDT)=DGBTCL(APTDT)_U_$P($P(SDATA,U,18),";")_U_$P($P(SDATA,U,10),";")
K ^TMP($J,"SDAMA301"),DGARRAY,CLIEN,APTDT
EXIT ; exit routine
Q
ERR1 ; error condition
G QUIT^DGBTEND Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTE1 7229 printed Dec 13, 2024@01:40:39 Page 2
DGBTE1 ;ALB/SCK/GAH,LAB - BENEFICIARY TRAVEL FIND OLD CLAIM DATES ; 03/20/2019
+1 ;;1.0;Beneficiary Travel;**8,12,13,20,21,22,25,28,33,34,37,39**;September 25, 2001;Build 6
DATE ; get date for claim, either new or past date
+1 NEW DGBTDCLM
+2 KILL ^TMP("DGBT",$JOB),^TMP("DGBTARA",$JOB),DIR
+3 IF 'DGBTNEW
SET DIR("A",2)="Enter a 'P' to display Past CLAIM dates for editing."
+4 SET DIR("A",3)="Time is required when adding a new CLAIM."
SET DIR("A",4)=""
SET DIR("A",1)=""
SET DIR("A")="Select TRAVEL CLAIM DATE/TIME"
SET DIR("?")="^D HELP^DGBTE1A"
+5 SET DIR(0)="F"
SET DIR("B")="NOW"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO ERR1
+6 ;PAVEL - DGBT*1*20
SET CHZFLG=0
SET %DT="EXR"
SET DTSUB=$SELECT(Y="N":"NOW",Y="P":"OLD",Y="p":"OLD",1:"OTHR")_"^DGBTE1A"
DO @DTSUB
+7 ;PAVEL DGBT*1*20
if $PIECE(DTSUB,U,1)="OLD"&(Y1>0)
SET DGBTOLD=1
KILL DTSUB
+8 ;PAVEL DGBT*1*20
if $DATA(DTOUT)
GOTO ERR1
if Y1<0
GOTO DATE
SET DGBTA=Y1
if CHZFLG
GOTO SET
DATE1 ; for past claims, set DGBTDT to inverse date of claim date
+1 IF $DATA(^DGBT(392,"C",DFN))
Begin DoDot:1
+2 ; set past claims counter=0
SET DGBTC=0
SET DGBTDT=9999999-$EXTRACT(DGBTA,1,7)
+3 ; for latest date (topmost) search for past claims
+4 FOR I=DGBTDT:0
SET I=$ORDER(^DGBT(392,"AI",DFN,I))
if 'I!(I>(DGBTDT_.99999))
QUIT
SET DGBTC=DGBTC+1
SET DGBT(DGBTC)=9999999.99999-I
End DoDot:1
+5 IF '$DATA(DGBT)
GOTO LOCK
+6 WRITE !!,"There are other claims on this date.",!,"Select by number to edit or <RETURN> to add a new CLAIM.",!
+7 ; convert inverse claim date to external format through VADATE conversion routine
+8 FOR I=0:0
SET I=$ORDER(DGBT(I))
if 'I
QUIT
Begin DoDot:1
+9 SET DGBTDCLM=$$GET1^DIQ(392,DGBT(I),45,"I")
+10 SET VADAT("W")=DGBT(I)
DO ^VADATE
WRITE !?5,I,".",?10,VADATE("E")_$SELECT($GET(DGBTDCLM)'="":" (D)",1:"")
End DoDot:1
+11 KILL DIR
SET DIR("A")="Select 1"_$SELECT(DGBTC=1:"",1:"-"_DGBTC)_", or <RETURN> to add a new claim: "
SET DIR(0)="NOA^1:"_DGBTC
SET DIR("?")="Select, by number, one of the displayed claim dates: "
+12 DO ^DIR
KILL DIR
if $GET(Y)
SET CHZFLG=1
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO QUIT^DGBTEND
+13 if Y=""
GOTO LOCK
if '$DATA(DGBT(Y))
GOTO DATE
+14 SET DGBTA=DGBT(Y)
SET DGBTOLD=1
GOTO SET
LOCK ;
+1 ;L +^DGBT(392,DGBTA):$G(DILOCKTM,3)
+2 ;I '$T!$D(^DGBT(392,DGBTA)) L -^DGBT(392,DGBTA) S DGBTA=$$FMADD^XLFDT(DGBTA,,,,1) G LOCK ;dbe patch DGBT*1*21
+3 ;dgbt*1.0*33 - more efficient lookup
+4 FOR
if '$DATA(^DGBT(392,DGBTA))
QUIT
SET DGBTA=$$FMADD^XLFDT(DGBTA,,,,1)
+5 ;dgbt*1.0*34 - added to increment if lock exists for record # that has not been created yet
LOCK +^DGBT(392,DGBTA):$GET(DILOCKTM,3)
IF '$TEST
SET DGBTA=$$FMADD^XLFDT(DGBTA,,,,1)
GOTO LOCK
+6 ;for CCR235 by RE
SET (DGBTDT,VADAT("W"))=DGBTA
DO ^VADATE
WRITE VADATE("E")
ASKADD ;
+1 WRITE !!,"Are you sure you want to add a new claim"
+2 ;dgbt*1.0*34 - unlock record immediately if user chooses no or exits
SET %=1
DO YN^DICN
IF (%<0)!(%=2)
LOCK -^DGBT(392,DGBTA)
GOTO EXIT2^DGBTE
+3 IF '%
WRITE !!,"Enter 'YES' to add a new claim, or 'NO' not to add the claim."
GOTO ASKADD
+4 KILL DD,DO
+5 ; create new file entry, stuff patient DFN into name field(pointer)
+6 ;DGBT*1.0*37 replace 4 slashes with ///, 2///' - ' allows for internal value to be validated and pushed in.
+7 SET (X,DINUM)=DGBTA
SET DIC="^DGBT(392,"
SET DIC(0)="L"
SET DIC("DR")="2///`"_DFN
+8 DO FILE^DICN
KILL DIC
LOCK -^DGBT(392,DGBTA)
+9 ; go back to patient if no file entry
+10 if Y'>0
GOTO PATIENT^DGBTE
SET ; call inhouse generic date routine
+1 SET (DA,DGBTDT,VADAT("W"))=DGBTA
DO ^VADATE
+2 ; get internal and external formats of converted inverse dates
+3 SET DGBTDTI=$SELECT($GET(VADAT("W"))'="":VADAT("W"),1:VADATE("I"))
SET DGBTDTE=VADATE("E")
KILL VADAT,VADATE,DIC,Y
+4 IF $GET(DGBTDIVI)'=""
SET DGBTDIVN=$PIECE(^DG(40.8,DGBTDIVI,0),"^",7)
+5 ;Get Alternate Income PAVEL
DO GA^DGBTUTL(DFN,"DGBTINCA",DGBTDTI)
STUFF ; stuff departure with address data from patient file, dest from institution file
+1 SET DGBTCMTY=$$GET1^DIQ(392,DGBTDT,56)
+2 if '$LENGTH(DGBTCMTY)
SET DGBTCMTY="M"
+3 ;*39 - get values for address
DO RESADDR^DGBTUTL1(.DGBTADDR)
+4 ;dbe patch DGBT*1*25 - removed restrictions below to allow departure and destination fields to get filed for existing claims
+5 ;*39 - updated to use residential address
if '$DATA(^DGBT(392,DGBTDT,"D"))
SET ^DGBT(392,DGBTDT,"D")=DGBTADDR(1)_"^"_DGBTADDR(2)_"^"_DGBTADDR(3)_"^"_DGBTADDR(4)_"^"_$SELECT(DGBTADDR(5)]"":+DGBTADDR(5),1:"")_"^"_$PIECE(DGBTADDR(6),U)
+6 IF '$DATA(^DGBT(392,DGBTDT,"T"))
Begin DoDot:1
+7 SET X=$SELECT($DATA(^DIC(4,DGBTDIVN,1)):^(1),1:"")
+8 ;*28 remove hyphen from zip code
SET ^DGBT(392,DGBTDT,"T")=($PIECE(^DG(40.8,DGBTDIVI,0),U)_"^"_$PIECE(X,U)_"^"_$PIECE(X,U,2)_"^"_$PIECE(X,U,3)_"^"_$PIECE(^DIC(4,DGBTDIVN,0),U,2)_"^"_$TRANSLATE($PIECE(X,U,4),"-",""))
End DoDot:1
+9 ;dbe patch DGBT*1*25 - added quit when called from routine dgbtee
if $GET(DGBTSP2M)
QUIT
CHKFILES ; section removed, dependents picked up below in MEANS ; abr 10/94
MEANS ; find corres. means test entry, gets MT income, status, no. of dependents
+1 ;DGBTMTS= MT Status; DGBTCSC= claim Service Connected indicator & %; DGBTELG=Eligibility status
+2 NEW X,X2,X3,Y,DGBTIFL
+3 ; returns corres. MT info,X=IEN of last MT. passing a 3 will check both MT and RX Co-Pays
SET X=$$LST^DGMTCOU1(DFN,DT,3)
SET DGBTMTS=$PIECE(X,U,4)_U_$PIECE(X,U,3)
+4 ; get income, # dependents
+5 SET Y=$$INCOME^VAFMON(DFN,DGBTA,1)
+6 ;If income type is I or V ignore it PAVEL
if "I^V"[$PIECE(Y,U,2)
SET Y=U
+7 ;Set Alternate Income
if DGBTINCA
SET Y=$PIECE(DGBTINCA,U,2)_U_$EXTRACT($PIECE(DGBTINCA,U,4))
+8 ; returns income & source.
SET X=$PIECE(Y,U)
SET DGBTIFL=$PIECE(Y,U,2)
+9 IF X?1N.E!(X<0)
Begin DoDot:1
+10 IF X<0
SET X=0
+11 SET X2="0$"
SET X3=8
DO COMMA^%DTC
End DoDot:1
+12 SET DGBTINC=X_U_$GET(DGBTIFL)
KILL X,X2
+13 ; finds dependents Vet, Spouse, Children
SET DGBTDEP=$$DEP^VAFMON(DFN,DGBTA)
+14 ;Year to be displayed with Income
SET DGBTDTY=" (Year: "_$$FMTE^XLFDT($EXTRACT(DGBTDTI,1,3)_"0000")_")"
+15 ; Means test threshold
SET DGBTMTTH=$$MTTH^DGBTMTTH(DGBTDEP,DGBTDTI)
+16 ; RX co-pay threshold
SET DGBTRXTH=+$$THRES^IBARXEU1(DGBTDTI,1,DGBTDEP)
+17 ; valid income test y/n
SET DGBTDYFL=$$DAYFLAG^DGBTUTL
+18 ;
PREV ; if past claim get SC%, elig.
+1 IF CHZFLG
SET X=^DGBT(392,DGBTA,0)
SET DGBTELG=$PIECE(X,U,3)
SET DGBTCSC=$PIECE(X,U,4)
Begin DoDot:1
+2 ;dbe patch DGBT*1*22 - save division of existing claims
if $PIECE(X,U,11)
SET DGBTDIVI=+$PIECE(X,U,11)
SET DGBTDIVN=$PIECE($GET(^DG(40.8,DGBTDIVI,0)),U,7)
+3 if DGBTCSC
SET DGBTCSC=1_U_DGBTCSC
if 'DGBTCSC
SET DGBTCSC=0
+4 if DGBTELG
SET DGBTELG=DGBTELG_U_$PIECE(^DIC(8,DGBTELG,0),U)
End DoDot:1
CERT ; get last BT certification, get date, then get eligibility
+1 IF $DATA(^DGBT(392.2,"C",DFN))
Begin DoDot:1
+2 ;cd=cert date in inverse then external format, ce= eligibility, ca* = amt certified
+3 SET DGBTCD=$ORDER(^DGBT(392.2,"C",DFN,0))
SET DGBTCE=$PIECE(^DGBT(392.2,DGBTCD,0),"^",3)
+4 SET DGBTCA=$PIECE(^DGBT(392.2,DGBTCD,0),"^",4)
SET Y=9999999-$PIECE(DGBTCD,".")
+5 ; date conversion, y=cert date (internal)
XECUTE ^DD("DD")
+6 SET DGBTCD=Y
SET X=DGBTCA
SET X2="0$"
SET X3=8
KILL Y
DO COMMA^%DTC
SET DGBTCA=X
KILL X,X2,X3
End DoDot:1
APPTS ; search patient file for appointments through claim date (DTI+1), add dates to array DGBTCL
+1 NEW ERRCODE,DGARRAY,CLIEN,APTDT
SET DGARRAY("FLDS")="2;3;10;18"
+2 SET DGARRAY(4)=DFN
SET I=$$SDAPI^SDAMA301(.DGARRAY)
+3 ; I<0 = Error, I<0 = # of Records retrieved
+4 IF I<0
SET ERRCODE=$ORDER(^TMP($JOB,"SDAMA301",""))
SET I1=1
SET DGBTCL("ERROR")=^TMP($JOB,"SDAMA301",ERRCODE)
+5 IF I>0
Begin DoDot:1
+6 SET CLIEN=""
+7 FOR
SET CLIEN=$ORDER(^TMP($JOB,"SDAMA301",DFN,CLIEN))
if 'CLIEN
QUIT
Begin DoDot:2
+8 SET APTDT=DGBTDTI\1
+9 FOR
SET APTDT=$ORDER(^TMP($JOB,"SDAMA301",DFN,CLIEN,APTDT))
if 'APTDT!(APTDT>(DGBTDTI+1))
QUIT
Begin DoDot:3
+10 SET SDATA=^TMP($JOB,"SDAMA301",DFN,CLIEN,APTDT)
+11 SET DGBTCL(APTDT)=$PIECE($PIECE(^TMP($JOB,"SDAMA301",DFN,CLIEN,APTDT),U,2),";",2)_U_$PIECE($PIECE(SDATA,U,3),";")
+12 SET DGBTCL(APTDT)=DGBTCL(APTDT)_U_$PIECE($PIECE(SDATA,U,18),";")_U_$PIECE($PIECE(SDATA,U,10),";")
End DoDot:3
End DoDot:2
End DoDot:1
+13 KILL ^TMP($JOB,"SDAMA301"),DGARRAY,CLIEN,APTDT
EXIT ; exit routine
+1 QUIT
ERR1 ; error condition
+1 GOTO QUIT^DGBTEND
QUIT
