XDRUTL ;SF-IRMFO/RSD - XDR utilities ;11/3/95 16:32
;;7.3;TOOLKIT;**23**;Apr 25, 1995
;;
Q
;
NEWCP(XDR,XDRP) ;create new check point, returns 0=error or ien
;XDR=name, XDRP=parameters
Q:$G(XDR)="" 0
N %,XDRI,XDRJ,XDRF,XDRY
S %=$$FIND1^DIC(15.013,","_XDRMPDA_",","X",XDR) Q:% %
S XDRF="+1,"_XDRMPDA_",",XDRJ(15.013,XDRF,.01)=XDR
S:$D(XDRP) XDRJ(15.013,XDRF,1)=XDRP
D UPDATE^DIE("","XDRJ","XDRY")
Q $G(XDRY(1))
;
UPCP(XDR,XDRP) ;update check point, returns 0=error or ien
;XDR=name, XDRP=parameters
N XDRI,XDRJ,XDRF,XDRY
S XDRY=$$DICCP($G(XDR))
Q:'XDRY 0
S XDRF=XDRY_","_XDRMPDA_","
S:$D(XDRP) XDRJ(15.013,XDRF,1)=XDRP
D FILE^DIE("","XDRJ")
Q XDRY
;
COMCP(XDR) ;complete check point, returns 0=error or date/time
;XDR=name
N XDRD,XDRI,XDRJ,XDRY
S XDRY=$$DICCP($G(XDR))
Q:'XDRY 0
S XDRD=$$NOW^XLFDT,XDRJ(15.013,XDRY_","_XDRMPDA_",",1)=XDRD
D FILE^DIE("","XDRJ")
Q XDRD
;
VERCP(XDR) ;verify check point exists, returns 1=exist, 0=doesn't
;XDR=name
N XDRI,XDRY
S XDRY=$$DICCP($G(XDR))
Q $S('XDRY:0,1:1)
;
PARCP(XDR,XDRF) ;returns parameters of check point
;XDR=name, XDRF="PRE"
N XDRI,XDRY
I $G(XDRF)="PRE" N XDRCP S XDRCP="INI"
S XDRY=$$DICCP($G(XDR))
Q:'XDRY 0
Q $$GET1^DIQ(15.013,XDRY_","_XDRMPDA_",",1,"I")
;
DICCP(X) ;lookup check point, returns ien or 0
Q:$G(X)="" 0
I X=+X S Y=X Q:'$D(^VA(15,XDRMPDA,"CP",Y,0)) 0
E S Y=$$FIND1^DIC(15.013,","_XDRMPDA_",","X",X)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRUTL 1468 printed Dec 13, 2024@02:39:53 Page 2
XDRUTL ;SF-IRMFO/RSD - XDR utilities ;11/3/95 16:32
+1 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
+2 ;;
+3 QUIT
+4 ;
NEWCP(XDR,XDRP) ;create new check point, returns 0=error or ien
+1 ;XDR=name, XDRP=parameters
+2 if $GET(XDR)=""
QUIT 0
+3 NEW %,XDRI,XDRJ,XDRF,XDRY
+4 SET %=$$FIND1^DIC(15.013,","_XDRMPDA_",","X",XDR)
if %
QUIT %
+5 SET XDRF="+1,"_XDRMPDA_","
SET XDRJ(15.013,XDRF,.01)=XDR
+6 if $DATA(XDRP)
SET XDRJ(15.013,XDRF,1)=XDRP
+7 DO UPDATE^DIE("","XDRJ","XDRY")
+8 QUIT $GET(XDRY(1))
+9 ;
UPCP(XDR,XDRP) ;update check point, returns 0=error or ien
+1 ;XDR=name, XDRP=parameters
+2 NEW XDRI,XDRJ,XDRF,XDRY
+3 SET XDRY=$$DICCP($GET(XDR))
+4 if 'XDRY
QUIT 0
+5 SET XDRF=XDRY_","_XDRMPDA_","
+6 if $DATA(XDRP)
SET XDRJ(15.013,XDRF,1)=XDRP
+7 DO FILE^DIE("","XDRJ")
+8 QUIT XDRY
+9 ;
COMCP(XDR) ;complete check point, returns 0=error or date/time
+1 ;XDR=name
+2 NEW XDRD,XDRI,XDRJ,XDRY
+3 SET XDRY=$$DICCP($GET(XDR))
+4 if 'XDRY
QUIT 0
+5 SET XDRD=$$NOW^XLFDT
SET XDRJ(15.013,XDRY_","_XDRMPDA_",",1)=XDRD
+6 DO FILE^DIE("","XDRJ")
+7 QUIT XDRD
+8 ;
VERCP(XDR) ;verify check point exists, returns 1=exist, 0=doesn't
+1 ;XDR=name
+2 NEW XDRI,XDRY
+3 SET XDRY=$$DICCP($GET(XDR))
+4 QUIT $SELECT('XDRY:0,1:1)
+5 ;
PARCP(XDR,XDRF) ;returns parameters of check point
+1 ;XDR=name, XDRF="PRE"
+2 NEW XDRI,XDRY
+3 IF $GET(XDRF)="PRE"
NEW XDRCP
SET XDRCP="INI"
+4 SET XDRY=$$DICCP($GET(XDR))
+5 if 'XDRY
QUIT 0
+6 QUIT $$GET1^DIQ(15.013,XDRY_","_XDRMPDA_",",1,"I")
+7 ;
DICCP(X) ;lookup check point, returns ien or 0
+1 if $GET(X)=""
QUIT 0
+2 IF X=+X
SET Y=X
if '$DATA(^VA(15,XDRMPDA,"CP",Y,0))
QUIT 0
+3 IF '$TEST
SET Y=$$FIND1^DIC(15.013,","_XDRMPDA_",","X",X)
+4 QUIT Y
