| 1 | RMPR124P ;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 | FIX664 ;search and correct length in errors for specified fields in files 664
|
|---|
| 10 | W @IOF
|
|---|
| 11 | W !,"** THIS TEMPORARY PROCESS HAS BEEN PUT IN PLACE TO SCRUB (VIA USER **"
|
|---|
| 12 | W !,"** INTERACTION) ANY FIELDS IN FILE #664 AND FILE#660 THAT MAY HAVE **"
|
|---|
| 13 | W !,"** A FIELD LENGTH ERROR CAUSED BY THE GUI PROSTHETICS PURCHASING **"
|
|---|
| 14 | W !,"** MODULE WHICH WAS ALLOWING DATA OUTSIDE THE FIELD DEFINED LENGTH **"
|
|---|
| 15 | W !,"** LIMITATIONS. **"
|
|---|
| 16 | F1 S %=1,DTOUT=0 W !!,"WANT TO PROCEED WITH CLEANSING PROCESS" D YN^DICN I '% W !,"REPLY YES (Y) OR NO (N)" G F1
|
|---|
| 17 | S ANS=$S('(%-1):"Y",1:"N") I ANS="N"!$D(DIRUT)!$D(DUOUT) G EXIT
|
|---|
| 18 | W !!
|
|---|
| 19 | EN ;Entry Point.
|
|---|
| 20 | N DIR,DA,ZTRTN,ZTDESC,RMOPT,ZTSK,ZTQUEUED,ZTIO,POP
|
|---|
| 21 | S DIR("?")="Please enter 1, 2, or 3."
|
|---|
| 22 | S DIR("?",1)="Please note: Options 2 & 3 work directly from the temporary"
|
|---|
| 23 | S DIR("?",2)="file created by length error compile under Option 1 - COMPILE."
|
|---|
| 24 | S DIR("?",3)=""
|
|---|
| 25 | S DIR(0)="SO^1:COMPILE LENGTH ERRORS;2:PRINT LENGTH ERROR REPORT;3:FIX LENGTH ERRORS"
|
|---|
| 26 | S DIR("L",1)="Select one of the following:"
|
|---|
| 27 | S DIR("L",2)=""
|
|---|
| 28 | S DIR("L",3)="1 Compile 2 Report 3 Fix Length Errors"
|
|---|
| 29 | D ^DIR
|
|---|
| 30 | S RMOPT=Y
|
|---|
| 31 | Q:RMOPT=""
|
|---|
| 32 | K DIR,DA Q:$D(DIRUT)
|
|---|
| 33 | I RMOPT=1 D ASKCMP Q
|
|---|
| 34 | I RMOPT=2 D PRINT^RMPRFPRT Q
|
|---|
| 35 | I RMOPT=3 D FIX Q
|
|---|
| 36 | G EXIT
|
|---|
| 37 | ASKCMP ;COMPILE ASK
|
|---|
| 38 | N RMSTART,RMCREATE,RMPURGE,RMEND,RMREM
|
|---|
| 39 | S Y=$G(^XTMP("RMPRFIX","START COMPILE")) D DD^%DT S RMSTART=Y
|
|---|
| 40 | S Y=$G(^XTMP("RMPRFIX","END COMPILE")) D DD^%DT S RMEND=Y
|
|---|
| 41 | I RMEND="RUNNING" D Q
|
|---|
| 42 | .W !!,"Build started on ",RMSTART," still running!"
|
|---|
| 43 | .D WAIT
|
|---|
| 44 | S RMREM=$G(^XTMP("RMPRFIX","RMPR","COUNT"))
|
|---|
| 45 | I RMEND'="" D
|
|---|
| 46 | .W !!,"Last Build completed on ",RMEND
|
|---|
| 47 | .I +RMREM>0 W !!,"This build contains ",+RMREM," nodes to be fixed, ",+$P(RMREM,"^",2)," field length errors",!
|
|---|
| 48 | .I +RMREM=0 W !!,"There are 0 items to be fixed.",!
|
|---|
| 49 | S DIR("A")="Do you wish to continue with NEW Build? "
|
|---|
| 50 | S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 51 | D ^DIR
|
|---|
| 52 | K DA,DIR Q:$D(DIRUT)
|
|---|
| 53 | I Y=0 Q
|
|---|
| 54 | CMP ;COMPILE
|
|---|
| 55 | K %DT,Y
|
|---|
| 56 | K ^XTMP("RMPRFIX")
|
|---|
| 57 | D CLEAR^VALM1
|
|---|
| 58 | ;D BUILD^RMPR124P Q
|
|---|
| 59 | S ZTRTN="BUILD^RMPR124P"
|
|---|
| 60 | S ZTDESC="UTILITY FOR RMPR FIELD LENGTH ERRORS"
|
|---|
| 61 | S ZTSAVE("RM*")="",ZTSAVE("XM*")="",ZTIO=""
|
|---|
| 62 | D ^%ZTLOAD
|
|---|
| 63 | I $D(ZTSK) W !,"Request Queued!"
|
|---|
| 64 | D WAIT
|
|---|
| 65 | Q
|
|---|
| 66 | BUILD D NOW^%DTC S RMSTART=%
|
|---|
| 67 | S ^XTMP("RMPRFIX","START COMPILE")=RMSTART
|
|---|
| 68 | S ^XTMP("RMPRFIX","END COMPILE")="RUNNING"
|
|---|
| 69 | S ^XTMP("RMPRFIX",0)=$$FMADD^XLFDT(RMSTART,90)_"^"_RMSTART
|
|---|
| 70 | FIX ;FIX BY INTERNAL PTR FOR 660/664
|
|---|
| 71 | N IEN0,IEN4,R664,IEN42,R40,R42,R43,R660,R6601,R6609,FLD1,FLD2,FLD7,FLD15,FLD152,FLD154,FLD156,FLD19,FLD211,FLD9
|
|---|
| 72 | N FLD16,FLD21,FLD24,FLD25,FLD91,FLD92,FLD1D,FLD2,DIE,DA,DR,DA1,DA2,DA1A,FILE1,FILE2,END,DATA,LMIN,LMAX,WDS
|
|---|
| 73 | N DTOUT,DUOUT,DIRUT,DIR,I,J,ANS,TT,IWD,PCN,HSW,WDA,WDB,WDC,HDT,NUM,Y,TFND,TFIX,RMUSER,RMOBN,HIEN,RMPRCT1,RMPRCT2
|
|---|
| 74 | D:RMOPT=1 BEG^RMPRFFIX D:RMOPT=3 ENT^RMPRFFIX
|
|---|
| 75 | G EXIT:END=1
|
|---|
| 76 | EXIT0 W:RMOPT=3 !!,"** REPAIR PROCESS COMPLETE: ",$S(TFND=0:"NO FIELD LENGTH ERRORS FOUND",1:TFIX_" FIELD LENGTH ERRORS CORRECTED")
|
|---|
| 77 | EXIT I $G(END)=1,RMOPT=3 W !!,"** REPAIR PROCESS TERMINATED BY USER **" I TFIX>0 W " < ",TFIX_" FIELD LENGTH ERRORS CORRECTED"," >"
|
|---|
| 78 | I $G(RMOPT)=1 D
|
|---|
| 79 | . D NOW^%DTC S RMEND=%
|
|---|
| 80 | . S ^XTMP("RMPRFIX","RMPR","COUNT")=RMPRCT1_"^"_RMPRCT2
|
|---|
| 81 | . S ^XTMP("RMPRFIX","END COMPILE")=RMEND
|
|---|
| 82 | . D MAIL
|
|---|
| 83 | Q
|
|---|
| 84 | MAIL ;Send mail message when build complete.
|
|---|
| 85 | N XMAIL,XMSUB,XMDUZ,XMTEXT,RMTEXT,Y,XMY,XMMG,XMZ
|
|---|
| 86 | S Y=$G(RMSTART) D DD^%DT S PXSTART=Y
|
|---|
| 87 | S Y=$G(RMEND) D DD^%DT S PXEND=Y
|
|---|
| 88 | S ZTQUEUED=1
|
|---|
| 89 | S RMTEXT(1)="UTILITY FOR RMPR FIELD LENGTH ERRORS is ready to report & fix."
|
|---|
| 90 | S RMTEXT(1)="Compile for RMPR field length errors is complete and ready to report & fix."
|
|---|
| 91 | S RMTEXT(2)="Start time: "_$G(PXSTART)_" End time: "_$G(PXEND)
|
|---|
| 92 | S XMSUB="RMPR field length error cleanup...Build Completed.."
|
|---|
| 93 | S XMTEXT="RMTEXT(",XMDUZ=.5,XMY(DUZ)=""
|
|---|
| 94 | D ^XMD
|
|---|
| 95 | S ^XTMP("RMPRFIX","RMPR","RMMAIL")=$G(XMZ)_"^"_DUZ_"^"_$G(XMMG)
|
|---|
| 96 | Q
|
|---|
| 97 | WAIT ;
|
|---|
| 98 | ;Q:IO'=$G(IO("HOME"))
|
|---|
| 99 | N DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
|
|---|
| 100 | W ! S DIR(0)="E" S DIR("A")="Enter RETURN to continue" D ^DIR W !
|
|---|
| 101 | Q
|
|---|
