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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSREC3 2456 printed Nov 22, 2024@17:28:27 Page 2
PRCSREC3 ;WISC/KMB/DL-820 RECONCILIATION FOR ENTIRE SITE ;1/30/98 1445
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
NEW1 ;
+1 NEW I,J,K,PRC,PRCSZ,Z,FLIP,SITE,%
+2 if '$DATA(DT)
DO DT^DICRW
SET PRC("FY")=$EXTRACT(100+$EXTRACT(DT,2,3)+$EXTRACT(DT,4),2,3)
+3 SET PRC("QTR")=$EXTRACT(DT,4,5)
SET PRC("QTR")=$PIECE("2^2^2^3^3^3^4^4^4^1^1^1","^",PRC("QTR"))
+4 WRITE !,?32,"THIS IS A LONG REPORT",!,?10,"Please check the paper in your printer before selecting a device",!
+5 WRITE !,"Please wait while I loop through your control points."
+6 SET I=0
SET J=0
FOR
SET J=$ORDER(^PRC(420,"B",J))
if 'J
QUIT
SET I=I+1
SET SITE(I)=J
+7 FOR K=1:1:I
Begin DoDot:1
+8 SET FLIP=0
FOR
SET FLIP=$ORDER(^PRC(420,SITE(K),1,FLIP))
if 'FLIP
QUIT
SET FLIP1=$PIECE($GET(^PRC(420,SITE(K),1,FLIP,0)),"^")
if FLIP1=""
SET FLIP1=FLIP
SET ^TMP($JOB,K,FLIP)=SITE(K)_"-"_FLIP1
WRITE "."
End DoDot:1
PROCESS ;
+1 NEW STARTIME,Y
DO NOW^%DTC
SET (STARTIME,Y)=%
DO DD^%DT
WRITE !,"Beginning processing time: ",Y
+2 WRITE !!,"Please select a device for printing this report",!!
+3 SET IOP="Q"
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+4 IF $DATA(IO("Q"))
SET ZTSAVE("I")=""
SET ZTSAVE("^TMP($J,")=""
SET ZTSAVE("PRC*")=""
SET ZTRTN="PROCESS1^PRCSREC3"
DO ^%ZTLOAD
DO ^%ZISC
DO FINAL
QUIT
+5 DO PROCESS1
DO ^%ZISC
DO FINAL
QUIT
PROCESS1 ;
+1 FOR K=1:1:I
SET FLIP=0
FOR
SET FLIP=$ORDER(^TMP($JOB,K,FLIP))
if 'FLIP
QUIT
Begin DoDot:1
+2 SET PRC("SITE")=$PIECE(^TMP($JOB,K,FLIP),"-")
SET PRC("CP")=$PIECE(^TMP($JOB,K,FLIP),"-",2)
+3 SET (PRCSZ,Z)=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$PIECE(PRC("CP")," ")
DO QUE^PRCSP1A
End DoDot:1
+4 QUIT
FINAL ;
+1 NEW ENDTIME
DO NOW^%DTC
SET (ENDTIME,Y)=%
DO DD^%DT
WRITE !,"Ending processing time: ",Y,!,"Total time for processing: ",$$FMDIFF^XLFDT(ENDTIME,STARTIME,3),!
+2 WRITE !,"End of processing"
KILL ^TMP($JOB)
QUIT
RESTART ;
+1 NEW NX,NXX,I,J,K,PRC,PRCSZ,Z,FLIP,SITE,%
+2 WRITE !,"Use this option ONLY if you need to re-run your site running balance.",!
SET %=1
WRITE !,"Do you wish to continue"
DO YN^DICN
if %=0!(%=2)
QUIT
+3 if '$DATA(DT)
DO DT^DICRW
SET PRC("FY")=$EXTRACT(100+$EXTRACT(DT,2,3)+$EXTRACT(DT,4),2,3)
+4 SET PRC("QTR")=$EXTRACT(DT,4,5)
SET PRC("QTR")=$PIECE("2^2^2^3^3^3^4^4^4^1^1^1","^",PRC("QTR"))
+5 WRITE !,"Okay. What station number should I start from? //"
READ NX:DTIME
if '$TEST!(NX="^")!(+NX=0)
QUIT
SET J=NX-1
+6 WRITE !,"What control point should I start from? //"
READ NXX:DTIME
if '$TEST!(NXX="^")!(+NXX=0)
QUIT
SET FLIP=NXX-1
+7 WRITE !,"Looping through control points.."
+8 DO LOOP
DO PROCESS
+9 QUIT
LOOP SET I=0
FOR
SET J=$ORDER(^PRC(420,"B",J))
if 'J
QUIT
SET I=I+1
SET SITE(I)=J
+1 FOR K=1:1:I
Begin DoDot:1
+2 if SITE(K)'=NX
SET FLIP=0
FOR
SET FLIP=$ORDER(^PRC(420,SITE(K),1,FLIP))
if 'FLIP
QUIT
SET FLIP1=$PIECE($GET(^PRC(420,SITE(K),1,FLIP,0)),"^")
if FLIP1=""
SET FLIP1=FLIP
SET ^TMP($JOB,K,FLIP)=SITE(K)_"-"_FLIP1
WRITE "."
End DoDot:1
+3 QUIT
