| 1 | PRCSREC3 ;WISC/KMB/DL-820 RECONCILIATION FOR ENTIRE SITE ;1/30/98 1445
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | NEW1 ;
|
|---|
| 5 | N I,J,K,PRC,PRCSZ,Z,FLIP,SITE,%
|
|---|
| 6 | D:'$D(DT) DT^DICRW S PRC("FY")=$E(100+$E(DT,2,3)+$E(DT,4),2,3)
|
|---|
| 7 | S PRC("QTR")=$E(DT,4,5),PRC("QTR")=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",PRC("QTR"))
|
|---|
| 8 | W !,?32,"THIS IS A LONG REPORT",!,?10,"Please check the paper in your printer before selecting a device",!
|
|---|
| 9 | W !,"Please wait while I loop through your control points."
|
|---|
| 10 | S I=0,J=0 F S J=$O(^PRC(420,"B",J)) Q:'J S I=I+1,SITE(I)=J
|
|---|
| 11 | F K=1:1:I D
|
|---|
| 12 | .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 "."
|
|---|
| 13 | PROCESS ;
|
|---|
| 14 | N STARTIME,Y D NOW^%DTC S (STARTIME,Y)=% D DD^%DT W !,"Beginning processing time: ",Y
|
|---|
| 15 | W !!,"Please select a device for printing this report",!!
|
|---|
| 16 | S IOP="Q",%ZIS="QM" D ^%ZIS Q:POP
|
|---|
| 17 | I $D(IO("Q")) S ZTSAVE("I")="",ZTSAVE("^TMP($J,")="",ZTSAVE("PRC*")="",ZTRTN="PROCESS1^PRCSREC3" D ^%ZTLOAD D ^%ZISC D FINAL Q
|
|---|
| 18 | D PROCESS1 D ^%ZISC D FINAL Q
|
|---|
| 19 | PROCESS1 ;
|
|---|
| 20 | F K=1:1:I S FLIP=0 F S FLIP=$O(^TMP($J,K,FLIP)) Q:'FLIP D
|
|---|
| 21 | .S PRC("SITE")=$P(^TMP($J,K,FLIP),"-"),PRC("CP")=$P(^TMP($J,K,FLIP),"-",2)
|
|---|
| 22 | .S (PRCSZ,Z)=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ") D QUE^PRCSP1A
|
|---|
| 23 | QUIT
|
|---|
| 24 | FINAL ;
|
|---|
| 25 | 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),!
|
|---|
| 26 | W !,"End of processing" K ^TMP($J) Q
|
|---|
| 27 | RESTART ;
|
|---|
| 28 | N NX,NXX,I,J,K,PRC,PRCSZ,Z,FLIP,SITE,%
|
|---|
| 29 | 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)
|
|---|
| 30 | D:'$D(DT) DT^DICRW S PRC("FY")=$E(100+$E(DT,2,3)+$E(DT,4),2,3)
|
|---|
| 31 | S PRC("QTR")=$E(DT,4,5),PRC("QTR")=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",PRC("QTR"))
|
|---|
| 32 | W !,"Okay. What station number should I start from? //" R NX:DTIME Q:'$T!(NX="^")!(+NX=0) S J=NX-1
|
|---|
| 33 | W !,"What control point should I start from? //" R NXX:DTIME Q:'$T!(NXX="^")!(+NXX=0) S FLIP=NXX-1
|
|---|
| 34 | W !,"Looping through control points.."
|
|---|
| 35 | D LOOP,PROCESS
|
|---|
| 36 | QUIT
|
|---|
| 37 | LOOP S I=0 F S J=$O(^PRC(420,"B",J)) Q:'J S I=I+1,SITE(I)=J
|
|---|
| 38 | F K=1:1:I D
|
|---|
| 39 | .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 "."
|
|---|
| 40 | QUIT
|
|---|
