- 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 Feb 19, 2025@00:06:21 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