- RMPR71 ;PHX/JLT-CALCULATE AND PRINT 2927a ;10/01/1994
- ;;3.0;PROSTHETICS;**2**;Feb 09, 1996
- S (PAGE,TCI,TSC,TNSC,TCM,TCLH,TCLM,TCLHM,TCLC,TBI,TBH,TBM,TBC)=0
- D DIS Q
- HDR ;PRINT WORKSHEETS
- W @IOF W !,?3,"WORKSHEET FOR ORTHOTICS LABORATORY OR RESTORATIONS CLINIC REPORT",?69,"PAGE: " S PAGE=PAGE+1 W PAGE K RL S $P(RL,"-",IOM)="" W !,RL
- W !,"|IDENTIFICATION DATA",?21,"| APPLIANCES/SERVICES COMPLETED",?61,"| BACKLOG",?79,"|" K RL S $P(RL,"-",IOM)="" W !,RL
- W !,$$STAN^RMPR31U(RMPR("STA"))_"_"_$P(CODE,U)_"_"_$P($G(^RMPR(663,+$P(CODE,U,2),0)),U)
- W ?22,"#",?27,"PATIENTS",?37,"MATERIAL",?48,"LBR",?56,"LBR",?62,"#",?67,"LBR",?74,"COSTS"
- W !,"REQUEST",?9,"WORK",?17,"REQ",?22,"ITM",?27,"SC",?31,"NSC",?39,"COST",?48,"HRS",?56,"COST",?62,"ITM",?67,"HRS",?73,"CHARGED"
- W !,"DATE",?9,"ORDER",?17,"STA",?22,"(1)",?27,"(2)",?31,"(3)",?40,"(4)",?48,"(5)",?57,"(6)",?62,"(7)",?67,"(8)",?75,"(9)" K RL S $P(RL,"-",IOM)="" W !,RL
- Q
- TOT ;TOTALS
- I IOST["C-" I $Y<15 F W ! Q:$Y>14
- I IOST'["C-" I $Y<53 F W ! Q:$Y>53
- W !,?12,"TOTALS: ",?23,TCI,?27,TSC,?31,TNSC,?33,$J(TCM,10,2)
- W ?46,TCLHM
- W ?50,$J(TCLC,10,2),?63,TBI,?65
- W:TBM'<60 $J(TBH+$P(TBM/60,".")_"."_$S(TBM#60>9:TBM#60,1:"0"_TBM#60),5,2)
- W:TBM<60 $J(TBH_"."_$S(TBM>9:TBM,1:"0"_TBM),5,2) W ?70,$J(TBC,10,2)
- K RL S $P(RL,"-",IOM)="" W !,RL
- W !,"Period Covered",?22,"Name of Item",?59,"Segment No.",?71,"Item No." K RL S $P(RL,"-",IOM)="" W !,RL
- W !,$$FMTE^XLFDT(DATE(1),2)_" TO "_$$FMTE^XLFDT(DATE(2),2),?22,$P($G(^RMPR(663,+$P(CODE,U,2),0)),U,3),?62,$P(CODE,U),?73,$P($G(^RMPR(663,+$P(CODE,U,2),0)),U)
- I IOST["C-" S DIR(0)="E" D ^DIR I X="^" S RMPROUT=1
- S (PAGE,TCI,TSC,TNSC,TCM,TCLH,TCLM,TCLC,TCLHM,TBI,TBH,TBM,TBC)=0
- Q
- DIS S (RMPRWO,CODE)="" F S CODE=$O(^TMP($J,CODE)) Q:CODE=""!$D(RMPROUT) D HDR F RMPRDT=0:0 S RMPRDT=$O(^TMP($J,CODE,RMPRDT)) D:RMPRDT'>0 TOT Q:RMPRDT'>0!$D(RMPROUT) F S RMPRWO=$O(^TMP($J,CODE,RMPRDT,RMPRWO)) Q:RMPRWO=""!$D(RMPROUT) D
- .I $Y+4>IOSL,IOST["C-" S DIR(0)="E" D ^DIR S:X="^" RMPROUT=1 Q:X="^" D HDR
- .S RDATA=^TMP($J,CODE,RMPRDT,RMPRWO)
- .W !,$$FMTE^XLFDT(RMPRDT,2),?9,$P(RMPRWO,"-",4)_"-"_$P(RMPRWO,"-",5),?17,$$STAN^RMPR31U($P(RDATA,U)),?23,$P(RDATA,U,2),?27,$P(RDATA,U,3),?31,$P(RDATA,U,4)
- .N RMPRHRS
- .S RMPRHRS=$P(RDATA,U,6)_"."_$P(RDATA,U,7)
- .W ?35,$J($P(RDATA,U,5),8,2)
- .W ?46,$J(RMPRHRS,5,2)
- .W ?52,$J($P(RDATA,U,8),8,2),?63,$P(RDATA,U,9)
- .W ?65 W:$P(RDATA,U,11)'<60 $J($P(RDATA,U,10)+$P($P(RDATA,U,11)/60,".")_"."_$S($P(RDATA,U,11)#60>9:($P(RDATA,U,11)#60),1:"0"_($P(RDATA,U,11)#60)),5,2)
- .W:$P(RDATA,U,11)<60 $J($P(RDATA,U,10)_"."_$S($P(RDATA,U,11)>9:$P(RDATA,U,11),1:"0"_$P(RDATA,U,11)),5,2)
- .W ?72,$J($P(RDATA,U,12),8,2)
- .S TCI=TCI+$P(RDATA,U,2),TSC=TSC+$P(RDATA,U,3),TNSC=TNSC+$P(RDATA,U,4),TCM=TCM+$P(RDATA,U,5),TCLH=TCLH+$P(RDATA,U,6),TCLM=TCLM+$P(RDATA,U,7),TCLHM=TCLHM+($P(RDATA,U,6)_"."_$P(RDATA,U,7))
- .S TCLC=TCLC+$P(RDATA,U,8),TBI=TBI+$P(RDATA,U,9),TBH=TBH+$P(RDATA,U,10),TBM=TBM+$P(RDATA,U,11),TBC=TBC+$P(RDATA,U,12)
- .Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR71 3000 printed Feb 18, 2025@23:59:52 Page 2
- RMPR71 ;PHX/JLT-CALCULATE AND PRINT 2927a ;10/01/1994
- +1 ;;3.0;PROSTHETICS;**2**;Feb 09, 1996
- +2 SET (PAGE,TCI,TSC,TNSC,TCM,TCLH,TCLM,TCLHM,TCLC,TBI,TBH,TBM,TBC)=0
- +3 DO DIS
- QUIT
- HDR ;PRINT WORKSHEETS
- +1 WRITE @IOF
- WRITE !,?3,"WORKSHEET FOR ORTHOTICS LABORATORY OR RESTORATIONS CLINIC REPORT",?69,"PAGE: "
- SET PAGE=PAGE+1
- WRITE PAGE
- KILL RL
- SET $PIECE(RL,"-",IOM)=""
- WRITE !,RL
- +2 WRITE !,"|IDENTIFICATION DATA",?21,"| APPLIANCES/SERVICES COMPLETED",?61,"| BACKLOG",?79,"|"
- KILL RL
- SET $PIECE(RL,"-",IOM)=""
- WRITE !,RL
- +3 WRITE !,$$STAN^RMPR31U(RMPR("STA"))_"_"_$PIECE(CODE,U)_"_"_$PIECE($GET(^RMPR(663,+$PIECE(CODE,U,2),0)),U)
- +4 WRITE ?22,"#",?27,"PATIENTS",?37,"MATERIAL",?48,"LBR",?56,"LBR",?62,"#",?67,"LBR",?74,"COSTS"
- +5 WRITE !,"REQUEST",?9,"WORK",?17,"REQ",?22,"ITM",?27,"SC",?31,"NSC",?39,"COST",?48,"HRS",?56,"COST",?62,"ITM",?67,"HRS",?73,"CHARGED"
- +6 WRITE !,"DATE",?9,"ORDER",?17,"STA",?22,"(1)",?27,"(2)",?31,"(3)",?40,"(4)",?48,"(5)",?57,"(6)",?62,"(7)",?67,"(8)",?75,"(9)"
- KILL RL
- SET $PIECE(RL,"-",IOM)=""
- WRITE !,RL
- +7 QUIT
- TOT ;TOTALS
- +1 IF IOST["C-"
- IF $Y<15
- FOR
- WRITE !
- if $Y>14
- QUIT
- +2 IF IOST'["C-"
- IF $Y<53
- FOR
- WRITE !
- if $Y>53
- QUIT
- +3 WRITE !,?12,"TOTALS: ",?23,TCI,?27,TSC,?31,TNSC,?33,$JUSTIFY(TCM,10,2)
- +4 WRITE ?46,TCLHM
- +5 WRITE ?50,$JUSTIFY(TCLC,10,2),?63,TBI,?65
- +6 if TBM'<60
- WRITE $JUSTIFY(TBH+$PIECE(TBM/60,".")_"."_$SELECT(TBM#60>9:TBM#60,1:"0"_TBM#60),5,2)
- +7 if TBM<60
- WRITE $JUSTIFY(TBH_"."_$SELECT(TBM>9:TBM,1:"0"_TBM),5,2)
- WRITE ?70,$JUSTIFY(TBC,10,2)
- +8 KILL RL
- SET $PIECE(RL,"-",IOM)=""
- WRITE !,RL
- +9 WRITE !,"Period Covered",?22,"Name of Item",?59,"Segment No.",?71,"Item No."
- KILL RL
- SET $PIECE(RL,"-",IOM)=""
- WRITE !,RL
- +10 WRITE !,$$FMTE^XLFDT(DATE(1),2)_" TO "_$$FMTE^XLFDT(DATE(2),2),?22,$PIECE($GET(^RMPR(663,+$PIECE(CODE,U,2),0)),U,3),?62,$PIECE(CODE,U),?73,$PIECE($GET(^RMPR(663,+$PIECE(CODE,U,2),0)),U)
- +11 IF IOST["C-"
- SET DIR(0)="E"
- DO ^DIR
- IF X="^"
- SET RMPROUT=1
- +12 SET (PAGE,TCI,TSC,TNSC,TCM,TCLH,TCLM,TCLC,TCLHM,TBI,TBH,TBM,TBC)=0
- +13 QUIT
- DIS SET (RMPRWO,CODE)=""
- FOR
- SET CODE=$ORDER(^TMP($JOB,CODE))
- if CODE=""!$DATA(RMPROUT)
- QUIT
- DO HDR
- FOR RMPRDT=0:0
- SET RMPRDT=$ORDER(^TMP($JOB,CODE,RMPRDT))
- if RMPRDT'>0
- DO TOT
- if RMPRDT'>0!$DATA(RMPROUT)
- QUIT
- FOR
- SET RMPRWO=$ORDER(^TMP($JOB,CODE,RMPRDT,RMPRWO))
- if RMPRWO=""!$DATA(RMPROUT)
- QUIT
- Begin DoDot:1
- +1 IF $Y+4>IOSL
- IF IOST["C-"
- SET DIR(0)="E"
- DO ^DIR
- if X="^"
- SET RMPROUT=1
- if X="^"
- QUIT
- DO HDR
- +2 SET RDATA=^TMP($JOB,CODE,RMPRDT,RMPRWO)
- +3 WRITE !,$$FMTE^XLFDT(RMPRDT,2),?9,$PIECE(RMPRWO,"-",4)_"-"_$PIECE(RMPRWO,"-",5),?17,$$STAN^RMPR31U($PIECE(RDATA,U)),?23,$PIECE(RDATA,U,2),?27,$PIECE(RDATA,U,3),?31,$PIECE(RDATA,U,4)
- +4 NEW RMPRHRS
- +5 SET RMPRHRS=$PIECE(RDATA,U,6)_"."_$PIECE(RDATA,U,7)
- +6 WRITE ?35,$JUSTIFY($PIECE(RDATA,U,5),8,2)
- +7 WRITE ?46,$JUSTIFY(RMPRHRS,5,2)
- +8 WRITE ?52,$JUSTIFY($PIECE(RDATA,U,8),8,2),?63,$PIECE(RDATA,U,9)
- +9 WRITE ?65
- if $PIECE(RDATA,U,11)'<60
- WRITE $JUSTIFY($PIECE(RDATA,U,10)+$PIECE($PIECE(RDATA,U,11)/60,".")_"."_$SELECT($PIECE(RDATA,U,11)#60>9:($PIECE(RDATA,U,11)#60),1:"0"_($PIECE(RDATA,U,11)#60)),5,2)
- +10 if $PIECE(RDATA,U,11)<60
- WRITE $JUSTIFY($PIECE(RDATA,U,10)_"."_$SELECT($PIECE(RDATA,U,11)>9:$PIECE(RDATA,U,11),1:"0"_$PIECE(RDATA,U,11)),5,2)
- +11 WRITE ?72,$JUSTIFY($PIECE(RDATA,U,12),8,2)
- +12 SET TCI=TCI+$PIECE(RDATA,U,2)
- SET TSC=TSC+$PIECE(RDATA,U,3)
- SET TNSC=TNSC+$PIECE(RDATA,U,4)
- SET TCM=TCM+$PIECE(RDATA,U,5)
- SET TCLH=TCLH+$PIECE(RDATA,U,6)
- SET TCLM=TCLM+$PIECE(RDATA,U,7)
- SET TCLHM=TCLHM+($PIECE(RDATA,U,6)_"."_$PIECE(RDATA,U,7))
- +13 SET TCLC=TCLC+$PIECE(RDATA,U,8)
- SET TBI=TBI+$PIECE(RDATA,U,9)
- SET TBH=TBH+$PIECE(RDATA,U,10)
- SET TBM=TBM+$PIECE(RDATA,U,11)
- SET TBC=TBC+$PIECE(RDATA,U,12)
- +14 QUIT
- End DoDot:1
