41 lines
2.4 KiB
Mathematica
41 lines
2.4 KiB
Mathematica
PRCSREC3 ;WISC/KMB/DL-820 RECONCILIATION FOR ENTIRE SITE ;1/30/98 1445
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
NEW1 ;
|
|
N I,J,K,PRC,PRCSZ,Z,FLIP,SITE,%
|
|
D:'$D(DT) DT^DICRW S PRC("FY")=$E(100+$E(DT,2,3)+$E(DT,4),2,3)
|
|
S PRC("QTR")=$E(DT,4,5),PRC("QTR")=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",PRC("QTR"))
|
|
W !,?32,"THIS IS A LONG REPORT",!,?10,"Please check the paper in your printer before selecting a device",!
|
|
W !,"Please wait while I loop through your control points."
|
|
S I=0,J=0 F S J=$O(^PRC(420,"B",J)) Q:'J S I=I+1,SITE(I)=J
|
|
F K=1:1:I D
|
|
.S FLIP=0 F S FLIP=$O(^PRC(420,SITE(K),1,FLIP)) Q:'FLIP S FLIP1=$P($G(^PRC(420,SITE(K),1,FLIP,0)),"^") S:FLIP1="" FLIP1=FLIP S ^TMP($J,K,FLIP)=SITE(K)_"-"_FLIP1 W "."
|
|
PROCESS ;
|
|
N STARTIME,Y D NOW^%DTC S (STARTIME,Y)=% D DD^%DT W !,"Beginning processing time: ",Y
|
|
W !!,"Please select a device for printing this report",!!
|
|
S IOP="Q",%ZIS="QM" D ^%ZIS Q:POP
|
|
I $D(IO("Q")) S ZTSAVE("I")="",ZTSAVE("^TMP($J,")="",ZTSAVE("PRC*")="",ZTRTN="PROCESS1^PRCSREC3" D ^%ZTLOAD D ^%ZISC D FINAL Q
|
|
D PROCESS1 D ^%ZISC D FINAL Q
|
|
PROCESS1 ;
|
|
F K=1:1:I S FLIP=0 F S FLIP=$O(^TMP($J,K,FLIP)) Q:'FLIP D
|
|
.S PRC("SITE")=$P(^TMP($J,K,FLIP),"-"),PRC("CP")=$P(^TMP($J,K,FLIP),"-",2)
|
|
.S (PRCSZ,Z)=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ") D QUE^PRCSP1A
|
|
QUIT
|
|
FINAL ;
|
|
N ENDTIME D NOW^%DTC S (ENDTIME,Y)=% D DD^%DT W !,"Ending processing time: ",Y,!,"Total time for processing: ",$$FMDIFF^XLFDT(ENDTIME,STARTIME,3),!
|
|
W !,"End of processing" K ^TMP($J) Q
|
|
RESTART ;
|
|
N NX,NXX,I,J,K,PRC,PRCSZ,Z,FLIP,SITE,%
|
|
W !,"Use this option ONLY if you need to re-run your site running balance.",! S %=1 W !,"Do you wish to continue" D YN^DICN Q:%=0!(%=2)
|
|
D:'$D(DT) DT^DICRW S PRC("FY")=$E(100+$E(DT,2,3)+$E(DT,4),2,3)
|
|
S PRC("QTR")=$E(DT,4,5),PRC("QTR")=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",PRC("QTR"))
|
|
W !,"Okay. What station number should I start from? //" R NX:DTIME Q:'$T!(NX="^")!(+NX=0) S J=NX-1
|
|
W !,"What control point should I start from? //" R NXX:DTIME Q:'$T!(NXX="^")!(+NXX=0) S FLIP=NXX-1
|
|
W !,"Looping through control points.."
|
|
D LOOP,PROCESS
|
|
QUIT
|
|
LOOP S I=0 F S J=$O(^PRC(420,"B",J)) Q:'J S I=I+1,SITE(I)=J
|
|
F K=1:1:I D
|
|
.S:SITE(K)'=NX FLIP=0 F S FLIP=$O(^PRC(420,SITE(K),1,FLIP)) Q:'FLIP S FLIP1=$P($G(^PRC(420,SITE(K),1,FLIP,0)),"^") S:FLIP1="" FLIP1=FLIP S ^TMP($J,K,FLIP)=SITE(K)_"-"_FLIP1 W "."
|
|
QUIT
|