XDRUTL.m

XDRUTL ;SF-IRMFO/RSD - XDR utilities ;11/3/95  16:32 [ 04/02/2003   8:47 AM ]

 ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 ;;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

XDRUTL    ;SF-IRMFO/RSD - XDR utilities ;11/3/95  16:32 [ 04/02/2003   8:47 AM ]

 +1       ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 +2       ;;7.3;TOOLKIT;**23**;Apr 25, 1995

 +3       ;;

 +4        QUIT 

 +5       ;

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