| 1 | RMPRFPRT ;VMP/RB - FIX FIELD LENGTH PROBLEMS FOR FILES #660/664 ;01/13/06
|
|---|
| 2 | ;;3.0;Prosthetics;**124**;06/20/05;Build 17
|
|---|
| 3 | ;;
|
|---|
| 4 | ;1. Post install to correct fields with length error created during
|
|---|
| 5 | ; cut & paste for function key input during GUI process and passed
|
|---|
| 6 | ; to VISTA files 660 and 664 for fields: Brief Description, Remarks,
|
|---|
| 7 | ; Serial #, Manufacturer, Model and Lot #
|
|---|
| 8 | ;
|
|---|
| 9 | PRINT ;print compile field length errors for specified fields in files 664/660
|
|---|
| 10 | N %ZIS
|
|---|
| 11 | I $G(^XTMP("RMPRFIX","END COMPILE"))="RUNNING" D Q
|
|---|
| 12 | .W !!,"Build is running, please wait until complete!"
|
|---|
| 13 | .D WAIT
|
|---|
| 14 | I +$G(^XTMP("RMPRFIX","RMPR","COUNT"))=0 D Q
|
|---|
| 15 | .W !!,"No field length errors found!"
|
|---|
| 16 | .D WAIT
|
|---|
| 17 | S %ZIS="Q" D ^%ZIS Q:POP I '$D(IO("Q")) U IO D PRINT1 Q
|
|---|
| 18 | S ZTRTN="PRINT1^RMPRFPRT",ZTDESC="RMPR LNGTH ERR RPT" D ^%ZTLOAD,HOME^%ZIS
|
|---|
| 19 | Q
|
|---|
| 20 | PRINT1 ;
|
|---|
| 21 | N RMEND,PG,ORG,HIEN,DATA,XD,FLD,IEN,ERR,ITEM,OBN,IOSL
|
|---|
| 22 | S (ORG,RMEND,IEN,HIEN,PG)=0,U="^",IOSL=66 S:$E(IOST,1,2)="C-" IOSL=22
|
|---|
| 23 | F S ORG=$O(^XTMP("RMPRFIX","RMPR",ORG)),IEN=0 Q:ORG=""!(ORG]"@")!RMEND D
|
|---|
| 24 | .S PG=0,ORGN=$P(^VA(200,ORG,0),U)
|
|---|
| 25 | .F S IEN=$O(^XTMP("RMPRFIX","RMPR",ORG,IEN)),ITEM="" Q:IEN=""!RMEND D
|
|---|
| 26 | ..F S ITEM=$O(^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM)),FLD=0 Q:ITEM=""!RMEND D
|
|---|
| 27 | ...F S FLD=$O(^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM,FLD)) Q:FLD=""!RMEND D
|
|---|
| 28 | ....S ERR=^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM,FLD)
|
|---|
| 29 | ....I IEN'=HIEN D HDR Q:RMEND S HIEN=IEN
|
|---|
| 30 | ....I $Y+4>IOSL D HDR Q:RMEND
|
|---|
| 31 | ....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)
|
|---|
| 32 | ....W ?70,ITEM,"/",$P(ERR,U,10),!
|
|---|
| 33 | ....S DATA=$P(ERR,U,12)
|
|---|
| 34 | ....F I=1:70 S XD=$E(DATA,I,I+69) Q:XD="" D Q:RMEND
|
|---|
| 35 | .....I $Y+2>IOSL D HDR Q:RMEND
|
|---|
| 36 | .....W ! W:I=1 "DATA: " W ?8,XD
|
|---|
| 37 | W @IOF
|
|---|
| 38 | D ^%ZISC
|
|---|
| 39 | Q
|
|---|
| 40 | HDR ;
|
|---|
| 41 | I PG,$E(IOST,1,2)="C-" S RMEND=$$EOP^ESPUTIL() Q:RMEND W @IOF
|
|---|
| 42 | E W @IOF
|
|---|
| 43 | S PG=PG+1
|
|---|
| 44 | W !!,?23,"File 664/660 Field Length Errors",?70,"Page ",PG,!
|
|---|
| 45 | W !,"Originator=>> ",ORGN,!
|
|---|
| 46 | W !,?2,"IEN",?20,"Patient Name",?50,"IFCAP ORDER",!
|
|---|
| 47 | W !,?2,IEN,?20,$P(ERR,U,4),?50,$P(ERR,U,6),!
|
|---|
| 48 | Q
|
|---|
| 49 | WAIT ;
|
|---|
| 50 | ;Q:IO'=$G(IO("HOME"))
|
|---|
| 51 | N DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
|
|---|
| 52 | W ! S DIR(0)="E" S DIR("A")="Enter RETURN to continue" D ^DIR W !
|
|---|
| 53 | Q
|
|---|
