- 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 Apr 23, 2025@18:32:53 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
