source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSREC3.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1PRCSREC3 ;WISC/KMB/DL-820 RECONCILIATION FOR ENTIRE SITE ;1/30/98 1445
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4NEW1 ;
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 "."
13PROCESS ;
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
19PROCESS1 ;
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
24FINAL ;
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
27RESTART ;
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
37LOOP 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
Note: See TracBrowser for help on using the repository browser.