| [613] | 1 | LBRPUTL ;SFISC/JSR- LBR UTIL2;04/08/99  15:12 [ 05/12/2000  4:31 PM ] | 
|---|
|  | 2 | ;;2.5;Library;**8**;Mar 11, 2000 | 
|---|
|  | 3 | Q | 
|---|
|  | 4 | NEWCP(XPD,XPDC,XPDP) ;create new check point, returns 0=error or ien | 
|---|
|  | 5 | ;XPD=name, XPDC=call back, XPDP=parameters | 
|---|
|  | 6 | Q:$G(XPD)="" 0 | 
|---|
|  | 7 | N %,XPDI,XPDJ,XPDF,XPDY | 
|---|
|  | 8 | ;XPDCP="INI"=Pre-init, "INIT"=Post-init | 
|---|
|  | 9 | S XPDI=$S(XPDCP="INIT":9.716,1:9.713) | 
|---|
|  | 10 | S %=$$FIND1^DIC(XPDI,","_XPDA_",","X",XPD) Q:% % | 
|---|
|  | 11 | S XPDF="+1,"_XPDA_",",XPDJ(XPDI,XPDF,.01)=XPD | 
|---|
|  | 12 | S:$D(XPDC) XPDJ(XPDI,XPDF,2)=XPDC | 
|---|
|  | 13 | S:$D(XPDP) XPDJ(XPDI,XPDF,3)=XPDP | 
|---|
|  | 14 | D UPDATE^DIE("","XPDJ","XPDY") | 
|---|
|  | 15 | Q $G(XPDY(1)) | 
|---|
|  | 16 | ; | 
|---|
|  | 17 | UPCP(XPD,XPDP) ;update check point, returns 0=error or ien | 
|---|
|  | 18 | ;XPD=name, XPDP=parameters | 
|---|
|  | 19 | N XPDI,XPDJ,XPDF,XPDY | 
|---|
|  | 20 | ;XPDCP="INI"=Pre-init, "INIT"=Post-init | 
|---|
|  | 21 | S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD)) | 
|---|
|  | 22 | Q:'XPDY 0 | 
|---|
|  | 23 | S XPDF=XPDY_","_XPDA_"," | 
|---|
|  | 24 | S:$D(XPDP) XPDJ(XPDI,XPDF,3)=XPDP | 
|---|
|  | 25 | D FILE^DIE("","XPDJ") | 
|---|
|  | 26 | Q XPDY | 
|---|
|  | 27 | ; | 
|---|
|  | 28 | COMCP(XPD) ;complete check point, returns 0=error or date/time | 
|---|
|  | 29 | ;XPD=name | 
|---|
|  | 30 | N XPDD,XPDI,XPDJ,XPDY | 
|---|
|  | 31 | S XPDD=$$NOW^XLFDT() | 
|---|
|  | 32 | S $P(^XTMP("LBRY",LBRVSTA,XPD),"^",2)=XPDD | 
|---|
|  | 33 | Q XPDD | 
|---|
|  | 34 | ; | 
|---|
|  | 35 | VERCP(XPD) ;verify check point, returns 1=completed, 0=not | 
|---|
|  | 36 | ;-1=doesn't exist | 
|---|
|  | 37 | ;XPD=name | 
|---|
|  | 38 | N XPDI,XPDY | 
|---|
|  | 39 | S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD)) | 
|---|
|  | 40 | Q:'XPDY -1 | 
|---|
|  | 41 | Q ''$$GET1^DIQ(XPDI,XPDY_","_XPDA_",",1,"I") | 
|---|
|  | 42 | ; | 
|---|
|  | 43 | PARCP(XPD,XPDF) ;returns parameters of check point | 
|---|
|  | 44 | ; | 
|---|
|  | 45 | ;  Quit with the data value to set into the variable | 
|---|
|  | 46 | Q $P($G(^XTMP("LBRY",LBRVSTA,XPDF)),"^",1) | 
|---|
|  | 47 | ; | 
|---|
|  | 48 | CURCP(XPDF) ;returns current check point | 
|---|
|  | 49 | ;XPDF flag - 0=externel, 1=internal | 
|---|
|  | 50 | Q $S($G(XPDF):XPDCHECK,1:XPDCHECK(0)) | 
|---|
|  | 51 | ; | 
|---|
|  | 52 | DICCP(X) ;lookup check point, returns ien or 0 | 
|---|
|  | 53 | Q:$G(X)="" 0 | 
|---|
|  | 54 | ;if they pass ien, fail if can't find | 
|---|
|  | 55 | I X=+X S Y=X Q:'$D(^JSR(9.7,XPDA,XPDCP,Y,0)) 0 | 
|---|
|  | 56 | E  S Y=$$FIND1^DIC(XPDI,","_XPDA_",","X",X) | 
|---|
|  | 57 | Q Y | 
|---|
|  | 58 | MES(X)  ;record message, X=message or an array passed by reference | 
|---|
|  | 59 | N % | 
|---|
|  | 60 | I $D(X)#2 S %=X K X S X(1)=% | 
|---|
|  | 61 | ;write message | 
|---|
|  | 62 | F %=1:1 Q:'$D(X(%))  W !,X(%) | 
|---|
|  | 63 | Q:'$G(XPDA)  D WP^DIE(9.7,XPDA_",",20,"A","X") | 
|---|
|  | 64 | Q | 
|---|
|  | 65 | BMES(X) ;add blank line before message | 
|---|
|  | 66 | N % | 
|---|
|  | 67 | I $D(X)#2 S %=X K X S X(1)=" ",X(2)=% | 
|---|
|  | 68 | D MES(.X) | 
|---|
|  | 69 | Q | 
|---|
|  | 70 | ; | 
|---|