RMPRFPRT ;VMP/RB - FIX FIELD LENGTH PROBLEMS FOR FILES #660/664 ;01/13/06
;;3.0;Prosthetics;**124**;06/20/05;Build 17
;;
;1. Post install to correct fields with length error created during
; cut & paste for function key input during GUI process and passed
; to VISTA files 660 and 664 for fields: Brief Description, Remarks,
; Serial #, Manufacturer, Model and Lot #
;
PRINT ;print compile field length errors for specified fields in files 664/660
N %ZIS
I $G(^XTMP("RMPRFIX","END COMPILE"))="RUNNING" D Q
.W !!,"Build is running, please wait until complete!"
.D WAIT
I +$G(^XTMP("RMPRFIX","RMPR","COUNT"))=0 D Q
.W !!,"No field length errors found!"
.D WAIT
S %ZIS="Q" D ^%ZIS Q:POP I '$D(IO("Q")) U IO D PRINT1 Q
S ZTRTN="PRINT1^RMPRFPRT",ZTDESC="RMPR LNGTH ERR RPT" D ^%ZTLOAD,HOME^%ZIS
Q
PRINT1 ;
N RMEND,PG,ORG,HIEN,DATA,XD,FLD,IEN,ERR,ITEM,OBN,IOSL
S (ORG,RMEND,IEN,HIEN,PG)=0,U="^",IOSL=66 S:$E(IOST,1,2)="C-" IOSL=22
F S ORG=$O(^XTMP("RMPRFIX","RMPR",ORG)),IEN=0 Q:ORG=""!(ORG]"@")!RMEND D
.S PG=0,ORGN=$P(^VA(200,ORG,0),U)
.F S IEN=$O(^XTMP("RMPRFIX","RMPR",ORG,IEN)),ITEM="" Q:IEN=""!RMEND D
..F S ITEM=$O(^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM)),FLD=0 Q:ITEM=""!RMEND D
...F S FLD=$O(^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM,FLD)) Q:FLD=""!RMEND D
....S ERR=^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM,FLD)
....I IEN'=HIEN D HDR Q:RMEND S HIEN=IEN
....I $Y+4>IOSL D HDR Q:RMEND
....W !!,"Field: ",$P(ERR,U,3),?35,"Origin: ",$E($P(ERR,U,7),1,35),!,?10,"MIN: ",$P(ERR,U),?20,"MAX: ",$P(ERR,U,2),?35,"ERR LGTH: ",$P(ERR,U,5)
....W ?70,ITEM,"/",$P(ERR,U,10),!
....S DATA=$P(ERR,U,12)
....F I=1:70 S XD=$E(DATA,I,I+69) Q:XD="" D Q:RMEND
.....I $Y+2>IOSL D HDR Q:RMEND
.....W ! W:I=1 "DATA: " W ?8,XD
W @IOF
D ^%ZISC
Q
HDR ;
I PG,$E(IOST,1,2)="C-" S RMEND=$$EOP^ESPUTIL() Q:RMEND W @IOF
E W @IOF
S PG=PG+1
W !!,?23,"File 664/660 Field Length Errors",?70,"Page ",PG,!
W !,"Originator=>> ",ORGN,!
W !,?2,"IEN",?20,"Patient Name",?50,"IFCAP ORDER",!
W !,?2,IEN,?20,$P(ERR,U,4),?50,$P(ERR,U,6),!
Q
WAIT ;
;Q:IO'=$G(IO("HOME"))
N DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
W ! S DIR(0)="E" S DIR("A")="Enter RETURN to continue" D ^DIR W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRFPRT 2242 printed Sep 23, 2025@20:10:58 Page 2
RMPRFPRT ;VMP/RB - FIX FIELD LENGTH PROBLEMS FOR FILES #660/664 ;01/13/06
+1 ;;3.0;Prosthetics;**124**;06/20/05;Build 17
+2 ;;
+3 ;1. Post install to correct fields with length error created during
+4 ; cut & paste for function key input during GUI process and passed
+5 ; to VISTA files 660 and 664 for fields: Brief Description, Remarks,
+6 ; Serial #, Manufacturer, Model and Lot #
+7 ;
PRINT ;print compile field length errors for specified fields in files 664/660
+1 NEW %ZIS
+2 IF $GET(^XTMP("RMPRFIX","END COMPILE"))="RUNNING"
Begin DoDot:1
+3 WRITE !!,"Build is running, please wait until complete!"
+4 DO WAIT
End DoDot:1
QUIT
+5 IF +$GET(^XTMP("RMPRFIX","RMPR","COUNT"))=0
Begin DoDot:1
+6 WRITE !!,"No field length errors found!"
+7 DO WAIT
End DoDot:1
QUIT
+8 SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
IF '$DATA(IO("Q"))
USE IO
DO PRINT1
QUIT
+9 SET ZTRTN="PRINT1^RMPRFPRT"
SET ZTDESC="RMPR LNGTH ERR RPT"
DO ^%ZTLOAD
DO HOME^%ZIS
+10 QUIT
PRINT1 ;
+1 NEW RMEND,PG,ORG,HIEN,DATA,XD,FLD,IEN,ERR,ITEM,OBN,IOSL
+2 SET (ORG,RMEND,IEN,HIEN,PG)=0
SET U="^"
SET IOSL=66
if $EXTRACT(IOST,1,2)="C-"
SET IOSL=22
+3 FOR
SET ORG=$ORDER(^XTMP("RMPRFIX","RMPR",ORG))
SET IEN=0
if ORG=""!(ORG]"@")!RMEND
QUIT
Begin DoDot:1
+4 SET PG=0
SET ORGN=$PIECE(^VA(200,ORG,0),U)
+5 FOR
SET IEN=$ORDER(^XTMP("RMPRFIX","RMPR",ORG,IEN))
SET ITEM=""
if IEN=""!RMEND
QUIT
Begin DoDot:2
+6 FOR
SET ITEM=$ORDER(^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM))
SET FLD=0
if ITEM=""!RMEND
QUIT
Begin DoDot:3
+7 FOR
SET FLD=$ORDER(^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM,FLD))
if FLD=""!RMEND
QUIT
Begin DoDot:4
+8 SET ERR=^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM,FLD)
+9 IF IEN'=HIEN
DO HDR
if RMEND
QUIT
SET HIEN=IEN
+10 IF $Y+4>IOSL
DO HDR
if RMEND
QUIT
+11 WRITE !!,"Field: ",$PIECE(ERR,U,3),?35,"Origin: ",$EXTRACT($PIECE(ERR,U,7),1,35),!,?10,"MIN: ",$PIECE(ERR,U),?20,"MAX: ",$PIECE(ERR,U,2),?35,"ERR LGTH: ",$PIECE(ERR,U,5)
+12 WRITE ?70,ITEM,"/",$PIECE(ERR,U,10),!
+13 SET DATA=$PIECE(ERR,U,12)
+14 FOR I=1:70
SET XD=$EXTRACT(DATA,I,I+69)
if XD=""
QUIT
Begin DoDot:5
+15 IF $Y+2>IOSL
DO HDR
if RMEND
QUIT
+16 WRITE !
if I=1
WRITE "DATA: "
WRITE ?8,XD
End DoDot:5
if RMEND
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 WRITE @IOF
+18 DO ^%ZISC
+19 QUIT
HDR ;
+1 IF PG
IF $EXTRACT(IOST,1,2)="C-"
SET RMEND=$$EOP^ESPUTIL()
if RMEND
QUIT
WRITE @IOF
+2 IF '$TEST
WRITE @IOF
+3 SET PG=PG+1
+4 WRITE !!,?23,"File 664/660 Field Length Errors",?70,"Page ",PG,!
+5 WRITE !,"Originator=>> ",ORGN,!
+6 WRITE !,?2,"IEN",?20,"Patient Name",?50,"IFCAP ORDER",!
+7 WRITE !,?2,IEN,?20,$PIECE(ERR,U,4),?50,$PIECE(ERR,U,6),!
+8 QUIT
WAIT ;
+1 ;Q:IO'=$G(IO("HOME"))
+2 NEW DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+3 WRITE !
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue"
DO ^DIR
WRITE !
+4 QUIT
