Released RMPR*3*124 SEQ #98 Extracted from mail message **KIDS**:RMPR*3.0*124^ **INSTALL NAME** RMPR*3.0*124 "BLD",5964,0) RMPR*3.0*124^PROSTHETICS^0^3060620^y "BLD",5964,1,0) ^^2^2^3060130^ "BLD",5964,1,1,0) PROSTHETICS GUI PURCHASING NOT ADHERING TO VISTA FM DATA DICTIONARY FIELD "BLD",5964,1,2,0) LENGTHS FOR FILES #664/660. "BLD",5964,4,0) ^9.64PA^^ "BLD",5964,6.3) 17 "BLD",5964,"ABPKG") n "BLD",5964,"KRN",0) ^9.67PA^8989.52^19 "BLD",5964,"KRN",.4,0) .4 "BLD",5964,"KRN",.401,0) .401 "BLD",5964,"KRN",.402,0) .402 "BLD",5964,"KRN",.403,0) .403 "BLD",5964,"KRN",.5,0) .5 "BLD",5964,"KRN",.84,0) .84 "BLD",5964,"KRN",3.6,0) 3.6 "BLD",5964,"KRN",3.8,0) 3.8 "BLD",5964,"KRN",9.2,0) 9.2 "BLD",5964,"KRN",9.8,0) 9.8 "BLD",5964,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",5964,"KRN",9.8,"NM",1,0) RMPR124P^^0^B21830969 "BLD",5964,"KRN",9.8,"NM",2,0) RMPRFFIX^^0^B33824281 "BLD",5964,"KRN",9.8,"NM",3,0) RMPRFPRT^^0^B6320218 "BLD",5964,"KRN",9.8,"NM","B","RMPR124P",1) "BLD",5964,"KRN",9.8,"NM","B","RMPRFFIX",2) "BLD",5964,"KRN",9.8,"NM","B","RMPRFPRT",3) "BLD",5964,"KRN",19,0) 19 "BLD",5964,"KRN",19,"NM",0) ^9.68A^2^2 "BLD",5964,"KRN",19,"NM",1,0) RMPR FILE CLEANSING^^0^ "BLD",5964,"KRN",19,"NM",2,0) RMPR UTILITIES^^3 "BLD",5964,"KRN",19,"NM","B","RMPR FILE CLEANSING",1) "BLD",5964,"KRN",19,"NM","B","RMPR UTILITIES",2) "BLD",5964,"KRN",19.1,0) 19.1 "BLD",5964,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",5964,"KRN",101,0) 101 "BLD",5964,"KRN",409.61,0) 409.61 "BLD",5964,"KRN",771,0) 771 "BLD",5964,"KRN",870,0) 870 "BLD",5964,"KRN",8989.51,0) 8989.51 "BLD",5964,"KRN",8989.52,0) 8989.52 "BLD",5964,"KRN",8994,0) 8994 "BLD",5964,"KRN","B",.4,.4) "BLD",5964,"KRN","B",.401,.401) "BLD",5964,"KRN","B",.402,.402) "BLD",5964,"KRN","B",.403,.403) "BLD",5964,"KRN","B",.5,.5) "BLD",5964,"KRN","B",.84,.84) "BLD",5964,"KRN","B",3.6,3.6) "BLD",5964,"KRN","B",3.8,3.8) "BLD",5964,"KRN","B",9.2,9.2) "BLD",5964,"KRN","B",9.8,9.8) "BLD",5964,"KRN","B",19,19) "BLD",5964,"KRN","B",19.1,19.1) "BLD",5964,"KRN","B",101,101) "BLD",5964,"KRN","B",409.61,409.61) "BLD",5964,"KRN","B",771,771) "BLD",5964,"KRN","B",870,870) "BLD",5964,"KRN","B",8989.51,8989.51) "BLD",5964,"KRN","B",8989.52,8989.52) "BLD",5964,"KRN","B",8994,8994) "BLD",5964,"QUES",0) ^9.62^^ "BLD",5964,"REQB",0) ^9.611^^ "KRN",19,5640,-1) 3^2 "KRN",19,5640,0) RMPR UTILITIES^Utilities^^M^^^^^^^^PROSTHETICS "KRN",19,5640,1,0) ^19.06^1^1^3060120^^^^ "KRN",19,5640,1,1,0) Prosthetic Utility Menu "KRN",19,5640,10,0) ^19.01IP^20^20 "KRN",19,5640,10,20,0) 12483^FCLN "KRN",19,5640,10,20,"^") RMPR FILE CLEANSING "KRN",19,5640,99) 60284,52159 "KRN",19,5640,"U") UTILITIES "KRN",19,12483,-1) 0^1 "KRN",19,12483,0) RMPR FILE CLEANSING^RMPR file cleansing for field lengths^^R^^^^^^^^PROSTHETICS^^ "KRN",19,12483,1,0) ^19.06^7^7^3060119^^^^ "KRN",19,12483,1,1,0) This option was created temporarily to be used by sites that "KRN",19,12483,1,2,0) enter fields in the GUI Purchasing module that exceeded the defined "KRN",19,12483,1,3,0) length in the VISTA data dictionary for Fileman. This option runs "KRN",19,12483,1,4,0) through file #664 to determine what fields, if any, exceed the "KRN",19,12483,1,5,0) maximum allowable lengths in files #664 and #660. Any field length "KRN",19,12483,1,6,0) discrepancies are displayed and the user is asked to enter a valid "KRN",19,12483,1,7,0) length response in lieu of the found incorrect data. "KRN",19,12483,10.1) CLEANSE FILES 664/661 "KRN",19,12483,20) "KRN",19,12483,25) RMPR124P "KRN",19,12483,"U") RMPR FILE CLEANSING FOR FIELD "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",101,-1) 1^1 "PKG",101,0) PROSTHETICS^RMPR^PROSTHETICS VERSION 3.0 ALPHA "PKG",101,20,0) ^9.402P^^0 "PKG",101,22,0) ^9.49I^1^1 "PKG",101,22,1,0) 3.0^2960209^2960214 "PKG",101,22,1,"PAH",1,0) 124^3060620 "PKG",101,22,1,"PAH",1,1,0) ^^2^2^3060620 "PKG",101,22,1,"PAH",1,1,1,0) PROSTHETICS GUI PURCHASING NOT ADHERING TO VISTA FM DATA DICTIONARY FIELD "PKG",101,22,1,"PAH",1,1,2,0) LENGTHS FOR FILES #664/660. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 3 "RTN","RMPR124P") 0^1^B21830969 "RTN","RMPR124P",1,0) RMPR124P ;VMP/RB - FIX FIELD LENGTH PROBLEMS FOR FILES #660/664 ;01/13/06 "RTN","RMPR124P",2,0) ;;3.0;Prosthetics;**124**;06/20/05;Build 17 "RTN","RMPR124P",3,0) ;; "RTN","RMPR124P",4,0) ;1. Post install to correct fields with length error created during "RTN","RMPR124P",5,0) ; cut & paste for function key input during GUI process and passed "RTN","RMPR124P",6,0) ; to VISTA files 660 and 664 for fields: Brief Description, Remarks, "RTN","RMPR124P",7,0) ; Serial #, Manufacturer, Model and Lot # "RTN","RMPR124P",8,0) ; "RTN","RMPR124P",9,0) FIX664 ;search and correct length in errors for specified fields in files 664 "RTN","RMPR124P",10,0) W @IOF "RTN","RMPR124P",11,0) W !,"** THIS TEMPORARY PROCESS HAS BEEN PUT IN PLACE TO SCRUB (VIA USER **" "RTN","RMPR124P",12,0) W !,"** INTERACTION) ANY FIELDS IN FILE #664 AND FILE#660 THAT MAY HAVE **" "RTN","RMPR124P",13,0) W !,"** A FIELD LENGTH ERROR CAUSED BY THE GUI PROSTHETICS PURCHASING **" "RTN","RMPR124P",14,0) W !,"** MODULE WHICH WAS ALLOWING DATA OUTSIDE THE FIELD DEFINED LENGTH **" "RTN","RMPR124P",15,0) W !,"** LIMITATIONS. **" "RTN","RMPR124P",16,0) 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 "RTN","RMPR124P",17,0) S ANS=$S('(%-1):"Y",1:"N") I ANS="N"!$D(DIRUT)!$D(DUOUT) G EXIT "RTN","RMPR124P",18,0) W !! "RTN","RMPR124P",19,0) EN ;Entry Point. "RTN","RMPR124P",20,0) N DIR,DA,ZTRTN,ZTDESC,RMOPT,ZTSK,ZTQUEUED,ZTIO,POP "RTN","RMPR124P",21,0) S DIR("?")="Please enter 1, 2, or 3." "RTN","RMPR124P",22,0) S DIR("?",1)="Please note: Options 2 & 3 work directly from the temporary" "RTN","RMPR124P",23,0) S DIR("?",2)="file created by length error compile under Option 1 - COMPILE." "RTN","RMPR124P",24,0) S DIR("?",3)="" "RTN","RMPR124P",25,0) S DIR(0)="SO^1:COMPILE LENGTH ERRORS;2:PRINT LENGTH ERROR REPORT;3:FIX LENGTH ERRORS" "RTN","RMPR124P",26,0) S DIR("L",1)="Select one of the following:" "RTN","RMPR124P",27,0) S DIR("L",2)="" "RTN","RMPR124P",28,0) S DIR("L",3)="1 Compile 2 Report 3 Fix Length Errors" "RTN","RMPR124P",29,0) D ^DIR "RTN","RMPR124P",30,0) S RMOPT=Y "RTN","RMPR124P",31,0) Q:RMOPT="" "RTN","RMPR124P",32,0) K DIR,DA Q:$D(DIRUT) "RTN","RMPR124P",33,0) I RMOPT=1 D ASKCMP Q "RTN","RMPR124P",34,0) I RMOPT=2 D PRINT^RMPRFPRT Q "RTN","RMPR124P",35,0) I RMOPT=3 D FIX Q "RTN","RMPR124P",36,0) G EXIT "RTN","RMPR124P",37,0) ASKCMP ;COMPILE ASK "RTN","RMPR124P",38,0) N RMSTART,RMCREATE,RMPURGE,RMEND,RMREM "RTN","RMPR124P",39,0) S Y=$G(^XTMP("RMPRFIX","START COMPILE")) D DD^%DT S RMSTART=Y "RTN","RMPR124P",40,0) S Y=$G(^XTMP("RMPRFIX","END COMPILE")) D DD^%DT S RMEND=Y "RTN","RMPR124P",41,0) I RMEND="RUNNING" D Q "RTN","RMPR124P",42,0) .W !!,"Build started on ",RMSTART," still running!" "RTN","RMPR124P",43,0) .D WAIT "RTN","RMPR124P",44,0) S RMREM=$G(^XTMP("RMPRFIX","RMPR","COUNT")) "RTN","RMPR124P",45,0) I RMEND'="" D "RTN","RMPR124P",46,0) .W !!,"Last Build completed on ",RMEND "RTN","RMPR124P",47,0) .I +RMREM>0 W !!,"This build contains ",+RMREM," nodes to be fixed, ",+$P(RMREM,"^",2)," field length errors",! "RTN","RMPR124P",48,0) .I +RMREM=0 W !!,"There are 0 items to be fixed.",! "RTN","RMPR124P",49,0) S DIR("A")="Do you wish to continue with NEW Build? " "RTN","RMPR124P",50,0) S DIR(0)="Y",DIR("B")="NO" "RTN","RMPR124P",51,0) D ^DIR "RTN","RMPR124P",52,0) K DA,DIR Q:$D(DIRUT) "RTN","RMPR124P",53,0) I Y=0 Q "RTN","RMPR124P",54,0) CMP ;COMPILE "RTN","RMPR124P",55,0) K %DT,Y "RTN","RMPR124P",56,0) K ^XTMP("RMPRFIX") "RTN","RMPR124P",57,0) D CLEAR^VALM1 "RTN","RMPR124P",58,0) ;D BUILD^RMPR124P Q "RTN","RMPR124P",59,0) S ZTRTN="BUILD^RMPR124P" "RTN","RMPR124P",60,0) S ZTDESC="UTILITY FOR RMPR FIELD LENGTH ERRORS" "RTN","RMPR124P",61,0) S ZTSAVE("RM*")="",ZTSAVE("XM*")="",ZTIO="" "RTN","RMPR124P",62,0) D ^%ZTLOAD "RTN","RMPR124P",63,0) I $D(ZTSK) W !,"Request Queued!" "RTN","RMPR124P",64,0) D WAIT "RTN","RMPR124P",65,0) Q "RTN","RMPR124P",66,0) BUILD D NOW^%DTC S RMSTART=% "RTN","RMPR124P",67,0) S ^XTMP("RMPRFIX","START COMPILE")=RMSTART "RTN","RMPR124P",68,0) S ^XTMP("RMPRFIX","END COMPILE")="RUNNING" "RTN","RMPR124P",69,0) S ^XTMP("RMPRFIX",0)=$$FMADD^XLFDT(RMSTART,90)_"^"_RMSTART "RTN","RMPR124P",70,0) FIX ;FIX BY INTERNAL PTR FOR 660/664 "RTN","RMPR124P",71,0) N IEN0,IEN4,R664,IEN42,R40,R42,R43,R660,R6601,R6609,FLD1,FLD2,FLD7,FLD15,FLD152,FLD154,FLD156,FLD19,FLD211,FLD9 "RTN","RMPR124P",72,0) N FLD16,FLD21,FLD24,FLD25,FLD91,FLD92,FLD1D,FLD2,DIE,DA,DR,DA1,DA2,DA1A,FILE1,FILE2,END,DATA,LMIN,LMAX,WDS "RTN","RMPR124P",73,0) 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 "RTN","RMPR124P",74,0) D:RMOPT=1 BEG^RMPRFFIX D:RMOPT=3 ENT^RMPRFFIX "RTN","RMPR124P",75,0) G EXIT:END=1 "RTN","RMPR124P",76,0) EXIT0 W:RMOPT=3 !!,"** REPAIR PROCESS COMPLETE: ",$S(TFND=0:"NO FIELD LENGTH ERRORS FOUND",1:TFIX_" FIELD LENGTH ERRORS CORRECTED") "RTN","RMPR124P",77,0) EXIT I $G(END)=1,RMOPT=3 W !!,"** REPAIR PROCESS TERMINATED BY USER **" I TFIX>0 W " < ",TFIX_" FIELD LENGTH ERRORS CORRECTED"," >" "RTN","RMPR124P",78,0) I $G(RMOPT)=1 D "RTN","RMPR124P",79,0) . D NOW^%DTC S RMEND=% "RTN","RMPR124P",80,0) . S ^XTMP("RMPRFIX","RMPR","COUNT")=RMPRCT1_"^"_RMPRCT2 "RTN","RMPR124P",81,0) . S ^XTMP("RMPRFIX","END COMPILE")=RMEND "RTN","RMPR124P",82,0) . D MAIL "RTN","RMPR124P",83,0) Q "RTN","RMPR124P",84,0) MAIL ;Send mail message when build complete. "RTN","RMPR124P",85,0) N XMAIL,XMSUB,XMDUZ,XMTEXT,RMTEXT,Y,XMY,XMMG,XMZ "RTN","RMPR124P",86,0) S Y=$G(RMSTART) D DD^%DT S PXSTART=Y "RTN","RMPR124P",87,0) S Y=$G(RMEND) D DD^%DT S PXEND=Y "RTN","RMPR124P",88,0) S ZTQUEUED=1 "RTN","RMPR124P",89,0) S RMTEXT(1)="UTILITY FOR RMPR FIELD LENGTH ERRORS is ready to report & fix." "RTN","RMPR124P",90,0) S RMTEXT(1)="Compile for RMPR field length errors is complete and ready to report & fix." "RTN","RMPR124P",91,0) S RMTEXT(2)="Start time: "_$G(PXSTART)_" End time: "_$G(PXEND) "RTN","RMPR124P",92,0) S XMSUB="RMPR field length error cleanup...Build Completed.." "RTN","RMPR124P",93,0) S XMTEXT="RMTEXT(",XMDUZ=.5,XMY(DUZ)="" "RTN","RMPR124P",94,0) D ^XMD "RTN","RMPR124P",95,0) S ^XTMP("RMPRFIX","RMPR","RMMAIL")=$G(XMZ)_"^"_DUZ_"^"_$G(XMMG) "RTN","RMPR124P",96,0) Q "RTN","RMPR124P",97,0) WAIT ; "RTN","RMPR124P",98,0) ;Q:IO'=$G(IO("HOME")) "RTN","RMPR124P",99,0) N DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT "RTN","RMPR124P",100,0) W ! S DIR(0)="E" S DIR("A")="Enter RETURN to continue" D ^DIR W ! "RTN","RMPR124P",101,0) Q "RTN","RMPRFFIX") 0^2^B33824281 "RTN","RMPRFFIX",1,0) RMPRFFIX ;VMP/RB - FIX FIELD LENGTH PROBLEMS FOR FILES #660/664 ;01/13/06 "RTN","RMPRFFIX",2,0) ;;3.0;Prosthetics;**124**;06/20/05;Build 17 "RTN","RMPRFFIX",3,0) ;; "RTN","RMPRFFIX",4,0) ;1. Post install to correct fields with length error created during "RTN","RMPRFFIX",5,0) ; cut & paste for function key input during GUI process and passed "RTN","RMPRFFIX",6,0) ; to VISTA files 660 and 664 for fields: Brief Description, Remarks, "RTN","RMPRFFIX",7,0) ; Serial #, Manufacturer, Model and Lot # "RTN","RMPRFFIX",8,0) ; "RTN","RMPRFFIX",9,0) BEG ;search and correct length in errors for specified fields in files 664/660 "RTN","RMPRFFIX",10,0) RD1 S IEN4=0,FILE2="^RMPR(660,",END=0,TT=0,TFND=0,TFIX=0,RMPRCT1=0,RMPRCT2=0 "RTN","RMPRFFIX",11,0) RD1A S IEN4=$O(^RMPR(664,IEN4)),HIEN=0 G EXIT:IEN4=""!(IEN4]"A") "RTN","RMPRFFIX",12,0) RD1AA S DIC="^RMPR(664,",DA=IEN4,DR="7.5;1;7.5;10;13;19;21.1",DIQ="D664",DIQ(0)="IE" D EN^DIQ1 "RTN","RMPRFFIX",13,0) S IEN0=$G(D664(664,IEN4,13,"I")),IEN42=0,HDT="",DFN=$G(D664(664,IEN4,1,"E")),RMUSER=$G(D664(664,IEN4,10,"I")),RMIFCAP=$G(D664(664,IEN4,7.5,"I")) "RTN","RMPRFFIX",14,0) S IWD="*SHIPPING* LINK",PCN=$G(D664(664,IEN4,7.5,"I")),FLD19=$G(D664(664,IEN4,19,"I")),FLD211=$G(D664(664,IEN4,21.1,"I")) "RTN","RMPRFFIX",15,0) K DIC,DA,DR,DIQ,D664 "RTN","RMPRFFIX",16,0) S IEN42=0,FILE1="^RMPR(664," "RTN","RMPRFFIX",17,0) D:IEN0>0 FIX660 G EXIT:END=1 "RTN","RMPRFFIX",18,0) RD1B S IEN42=$O(^RMPR(664,IEN4,1,IEN42)),HSW=0,NUM=IEN4_"-"_IEN42 I IEN42=""!(IEN42="B") G RD1A:RMOPT=1,ENTR "RTN","RMPRFFIX",19,0) S DIC="^RMPR(664,",DA=IEN4,DA(664.02)=IEN42,DR=2,DR(664.02)="1;7;12;15;15.2;15.4;15.6",DIQ="D664",DIQ(0)="I" D EN^DIQ1 "RTN","RMPRFFIX",20,0) S FLD1D=$G(D664(664.02,IEN42,1,"I")),FLD7=$G(D664(664.02,IEN42,7,"I")),FLD15=$G(D664(664.02,IEN42,15,"I")),IEN0=$G(D664(664.02,IEN42,12,"I")),IWD="ITEM "_IEN42_": "_$E(FLD1D,1,30) "RTN","RMPRFFIX",21,0) S FLD152=$G(D664(664.02,IEN42,15.2,"I")),FLD154=$G(D664(664.02,IEN42,15.4,"I")),FLD156=$G(D664(664.02,IEN42,15.6,"I")) "RTN","RMPRFFIX",22,0) K DIC,DA,DR,DIQ,D664 "RTN","RMPRFFIX",23,0) I IEN42<2,$L(FLD19)>30 S WDA=NUM,WDB="664-19 (Deliver To)",WDC=FLD19 D G ENTR:END=1 "RTN","RMPRFFIX",24,0) . S FLD1=19,FLD2="",DA1=IEN4,DA1A="",DA2="",LMIN=3,LMAX=30,WDS="Deliver To" "RTN","RMPRFFIX",25,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",26,0) I IEN42<2,$L(FLD211)>45 S WDA=NUM,WDB="664-21.1 (Deliver To Attention)",WDC=FLD211 D G ENTR:END=1 "RTN","RMPRFFIX",27,0) . S FLD1=21.1,FLD2=25,DA1=IEN4,DA1A="",DA2=IEN0,LMIN=0,LMAX=45,WDS="Deliver To Attention" "RTN","RMPRFFIX",28,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",29,0) I IEN42>1,HDT'="" D "RTN","RMPRFFIX",30,0) . S FLD2=25,DA1="",DA1A="",DA2=IEN0,DATA=HDT "RTN","RMPRFFIX",31,0) . D FILE "RTN","RMPRFFIX",32,0) S FILE1="^RMPR(664,IEN4,1," "RTN","RMPRFFIX",33,0) I $L(FLD1D)>60 S WDA=NUM,WDB="664-1 (Brief Description)",WDC=FLD1D D G ENTR:END=1 "RTN","RMPRFFIX",34,0) . S FLD1=1,FLD2=24,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=3,LMAX=60,WDS="Brief Description" "RTN","RMPRFFIX",35,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",36,0) I $L(FLD7)>30 S WDA=NUM,WDB="664-7 (Remarks)",WDC=FLD7 D G ENTR:END=1 "RTN","RMPRFFIX",37,0) . S FLD1=7,FLD2=16,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Remarks" "RTN","RMPRFFIX",38,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",39,0) I $L(FLD15)>15 S WDA=NUM,WDB="664-15 (Serial #)",WDC=FLD15 D G ENTR:END=1 "RTN","RMPRFFIX",40,0) . S FLD1=15,FLD2=9,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=3,LMAX=15,WDS="SERIAL #" "RTN","RMPRFFIX",41,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",42,0) I $L(FLD152)>30 S WDA=NUM,WDB="664-15.2 (Manufacturer)",WDC=FLD152 D G ENTR:END=1 "RTN","RMPRFFIX",43,0) . S FLD1=15.2,FLD2=9.1,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Manufacturer" "RTN","RMPRFFIX",44,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",45,0) I $L(FLD154)>30 S WDA=NUM,WDB="664-15.4 (Model)",WDC=FLD154 D G ENTR:END=1 "RTN","RMPRFFIX",46,0) . S FLD1=15.4,FLD2=9.2,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Model" "RTN","RMPRFFIX",47,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",48,0) I $L(FLD156)>30 S WDA=NUM,WDB="664-15.6 (Lot #)",WDC=FLD156 D G ENTR:END=1 "RTN","RMPRFFIX",49,0) . S FLD1=15.6,FLD2=21,DA1=IEN42,DA1A=IEN4,DA2=IEN0,LMIN=0,LMAX=30,WDS="Lot #" "RTN","RMPRFFIX",50,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",51,0) G RD1B "RTN","RMPRFFIX",52,0) FIX660 ;search and correct length in errors for specified fields in files 660 "RTN","RMPRFFIX",53,0) S HSW=0 "RTN","RMPRFFIX",54,0) S DIC="^RMPR(660,",DA=IEN0,DR="9;16;21;24:25;9.1;9.2",DIQ="D660",DIQ(0)="I" D EN^DIQ1 "RTN","RMPRFFIX",55,0) S FLD16=$G(D660(660,IEN0,16,"I")),FLD9=$G(D660(660,IEN0,9,"I")),FLD21=$G(D660(660,IEN0,21,"I")) "RTN","RMPRFFIX",56,0) S FLD24=$G(D660(660,IEN0,24,"I")),FLD91=$G(D660(660,IEN0,9.1,"I")),FLD92=$G(D660(660,IEN0,9.2,"I")) "RTN","RMPRFFIX",57,0) S FLD25=$G(D660(660,IEN0,25,"I")) "RTN","RMPRFFIX",58,0) K DIC,DA,DR,DIQ,D660 "RTN","RMPRFFIX",59,0) I $L(FLD25)>30 S WDA=IEN0,WDB="660-25 (Deliver To)",WDC=FLD25 D G ENTR:END=1 "RTN","RMPRFFIX",60,0) . S FLD2=25,DA2=IEN0,LMIN=3,LMAX=30,WDS="(Pros/Appliance Repair) Deliver To" "RTN","RMPRFFIX",61,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",62,0) I $L(FLD24)>60 S WDA=IEN0,WDB="660-24 (Brief Description)",WDC=FLD24 D G ENTR:END=1 "RTN","RMPRFFIX",63,0) . S FLD2=24,DA2=IEN0,LMIN=3,LMAX=60,WDS="(Pros/Appliance Repair) Brief Description" "RTN","RMPRFFIX",64,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",65,0) I $L(FLD16)>61 S WDA=IEN0,WDB="660-16 (Remarks)",WDC=FLD16 D G ENTR:END=1 "RTN","RMPRFFIX",66,0) . S FLD2=16,DA2=IEN0,LMIN=0,LMAX=61,WDS="(Pros/Appliance Repair) Remarks" "RTN","RMPRFFIX",67,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",68,0) I $L(FLD9)>20 S WDA=IEN0,WDB="660-9 (Serial #)",WDC=FLD9 D G ENTR:END=1 "RTN","RMPRFFIX",69,0) . S FLD2=9,DA2=IEN0,LMIN=0,LMAX=20,WDS="(Pros/Appliance Repair) Serial #" "RTN","RMPRFFIX",70,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",71,0) I $L(FLD21)>20 S WDA=IEN0,WDB="660-21 (Lot #)",WDC=FLD21 D G ENTR:END=1 "RTN","RMPRFFIX",72,0) . S FLD2=21,DA2=IEN0,LMIN=0,LMAX=20,WDS="(Pros/Appliance Repair) Lot #" "RTN","RMPRFFIX",73,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",74,0) I $L(FLD91)>55 S WDA=IEN0,WDB="660-91 (Manufacturer)",WDC=FLD91 D G ENTR:END=1 "RTN","RMPRFFIX",75,0) . S FLD2=9.1,DA2=IEN0,LMIN=0,LMAX=55,WDS="(Pros/Appliance Repair) Manufacturer" "RTN","RMPRFFIX",76,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",77,0) I $L(FLD92)>55 S WDA=IEN0,WDB="660-92 (Model)",WDC=FLD92 D G ENTR:END=1 "RTN","RMPRFFIX",78,0) . S FLD2=9.2,DA2=IEN0,LMIN=0,LMAX=55,WDS="(Pros/Appliance Repair) Model" "RTN","RMPRFFIX",79,0) . D ASK Q:END=1 D FILE "RTN","RMPRFFIX",80,0) Q "RTN","RMPRFFIX",81,0) ASK I RMOPT=1 D Q "RTN","RMPRFFIX",82,0) . S ^XTMP("RMPRFIX","RMPR",RMUSER,IEN4,IEN42,$P(WDB," "))=LMIN_U_LMAX_U_WDB_U_DFN_U_$L(WDC)_U_RMIFCAP_U_IWD_U_IEN4_U_IEN42_U_IEN0_U_WDA_U_WDC "RTN","RMPRFFIX",83,0) . S ^XTMP("RMPRFIX","RMPR","A",IEN4)="" "RTN","RMPRFFIX",84,0) . S RMPRCT2=RMPRCT2+1 "RTN","RMPRFFIX",85,0) . S:IEN4'=HIEN RMPRCT1=RMPRCT1+1,HIEN=IEN4 "RTN","RMPRFFIX",86,0) I HSW=0 W !,IEN4," / ",IEN0,?20,"PCN: ",PCN,?42,"ITEM: ",IWD "RTN","RMPRFFIX",87,0) S HSW=1,TFND=TFND+1 "RTN","RMPRFFIX",88,0) ;ASK NEW FIELD ENTRY WITH CORRECT LENGTH "RTN","RMPRFFIX",89,0) W !,WDA,?12,WDB,!,WDC,! "RTN","RMPRFFIX",90,0) S DIR("A")=WDS,DIR("?")=$S(LMIN=0:"Field length cannot exceed "_LMAX_" characters",1:"Field length must be "_LMIN_"-"_LMAX_" characters in length") "RTN","RMPRFFIX",91,0) S DIR(0)="F^"_LMIN_":"_LMAX "RTN","RMPRFFIX",92,0) W !,DIR("?"),! "RTN","RMPRFFIX",93,0) D ^DIR "RTN","RMPRFFIX",94,0) I $D(DUOUT)!$D(DIRUT) S END=1 Q "RTN","RMPRFFIX",95,0) S DATA=Y "RTN","RMPRFFIX",96,0) W ! "RTN","RMPRFFIX",97,0) Q "RTN","RMPRFFIX",98,0) FILE Q:RMOPT=1 "RTN","RMPRFFIX",99,0) K DA,DR,DIE "RTN","RMPRFFIX",100,0) I IEN42'=0,DA1'="" S DIE=FILE1,DA=DA1,DR=FLD1_"////^S X=DATA" S:DA1A DA(1)=DA1A D ^DIE K DA,DIE,DR "RTN","RMPRFFIX",101,0) I $G(FLD1)=19 S HDT=DATA "RTN","RMPRFFIX",102,0) Q:DA2=""!(FLD2="") "RTN","RMPRFFIX",103,0) S DIE=FILE2,DA=DA2,DR=FLD2_"////^S X=DATA" D ^DIE K DA,DIE,DR "RTN","RMPRFFIX",104,0) S TFIX=TFIX+1 "RTN","RMPRFFIX",105,0) Q "RTN","RMPRFFIX",106,0) ENT ;ASK INT TO FIX "RTN","RMPRFFIX",107,0) S IEN4=0,FILE2="^RMPR(660,",END=0,TFND=0,TFIX=0 "RTN","RMPRFFIX",108,0) ENTR ;664 INTERNAL FROM BUILD REPORT "RTN","RMPRFFIX",109,0) S DIR("A")="RECORD IDENTIFIER",DIR("?")="Enter record identifier from build list to be corrected" "RTN","RMPRFFIX",110,0) S DIR(0)="F" "RTN","RMPRFFIX",111,0) W !,DIR("?"),! "RTN","RMPRFFIX",112,0) D ^DIR "RTN","RMPRFFIX",113,0) I $D(DUOUT)!$D(DIRUT) S END=1 Q "RTN","RMPRFFIX",114,0) Q:Y="" "RTN","RMPRFFIX",115,0) S IEN4=Y "RTN","RMPRFFIX",116,0) I '$D(^XTMP("RMPRFIX","RMPR","A",Y)) W " ** NOT FOUND ON CORRECTION REPORT" G ENTR "RTN","RMPRFFIX",117,0) W ! "RTN","RMPRFFIX",118,0) G RD1AA "RTN","RMPRFFIX",119,0) EXIT Q "RTN","RMPRFPRT") 0^3^B6320218 "RTN","RMPRFPRT",1,0) RMPRFPRT ;VMP/RB - FIX FIELD LENGTH PROBLEMS FOR FILES #660/664 ;01/13/06 "RTN","RMPRFPRT",2,0) ;;3.0;Prosthetics;**124**;06/20/05;Build 17 "RTN","RMPRFPRT",3,0) ;; "RTN","RMPRFPRT",4,0) ;1. Post install to correct fields with length error created during "RTN","RMPRFPRT",5,0) ; cut & paste for function key input during GUI process and passed "RTN","RMPRFPRT",6,0) ; to VISTA files 660 and 664 for fields: Brief Description, Remarks, "RTN","RMPRFPRT",7,0) ; Serial #, Manufacturer, Model and Lot # "RTN","RMPRFPRT",8,0) ; "RTN","RMPRFPRT",9,0) PRINT ;print compile field length errors for specified fields in files 664/660 "RTN","RMPRFPRT",10,0) N %ZIS "RTN","RMPRFPRT",11,0) I $G(^XTMP("RMPRFIX","END COMPILE"))="RUNNING" D Q "RTN","RMPRFPRT",12,0) .W !!,"Build is running, please wait until complete!" "RTN","RMPRFPRT",13,0) .D WAIT "RTN","RMPRFPRT",14,0) I +$G(^XTMP("RMPRFIX","RMPR","COUNT"))=0 D Q "RTN","RMPRFPRT",15,0) .W !!,"No field length errors found!" "RTN","RMPRFPRT",16,0) .D WAIT "RTN","RMPRFPRT",17,0) S %ZIS="Q" D ^%ZIS Q:POP I '$D(IO("Q")) U IO D PRINT1 Q "RTN","RMPRFPRT",18,0) S ZTRTN="PRINT1^RMPRFPRT",ZTDESC="RMPR LNGTH ERR RPT" D ^%ZTLOAD,HOME^%ZIS "RTN","RMPRFPRT",19,0) Q "RTN","RMPRFPRT",20,0) PRINT1 ; "RTN","RMPRFPRT",21,0) N RMEND,PG,ORG,HIEN,DATA,XD,FLD,IEN,ERR,ITEM,OBN,IOSL "RTN","RMPRFPRT",22,0) S (ORG,RMEND,IEN,HIEN,PG)=0,U="^",IOSL=66 S:$E(IOST,1,2)="C-" IOSL=22 "RTN","RMPRFPRT",23,0) F S ORG=$O(^XTMP("RMPRFIX","RMPR",ORG)),IEN=0 Q:ORG=""!(ORG]"@")!RMEND D "RTN","RMPRFPRT",24,0) .S PG=0,ORGN=$P(^VA(200,ORG,0),U) "RTN","RMPRFPRT",25,0) .F S IEN=$O(^XTMP("RMPRFIX","RMPR",ORG,IEN)),ITEM="" Q:IEN=""!RMEND D "RTN","RMPRFPRT",26,0) ..F S ITEM=$O(^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM)),FLD=0 Q:ITEM=""!RMEND D "RTN","RMPRFPRT",27,0) ...F S FLD=$O(^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM,FLD)) Q:FLD=""!RMEND D "RTN","RMPRFPRT",28,0) ....S ERR=^XTMP("RMPRFIX","RMPR",ORG,IEN,ITEM,FLD) "RTN","RMPRFPRT",29,0) ....I IEN'=HIEN D HDR Q:RMEND S HIEN=IEN "RTN","RMPRFPRT",30,0) ....I $Y+4>IOSL D HDR Q:RMEND "RTN","RMPRFPRT",31,0) ....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) "RTN","RMPRFPRT",32,0) ....W ?70,ITEM,"/",$P(ERR,U,10),! "RTN","RMPRFPRT",33,0) ....S DATA=$P(ERR,U,12) "RTN","RMPRFPRT",34,0) ....F I=1:70 S XD=$E(DATA,I,I+69) Q:XD="" D Q:RMEND "RTN","RMPRFPRT",35,0) .....I $Y+2>IOSL D HDR Q:RMEND "RTN","RMPRFPRT",36,0) .....W ! W:I=1 "DATA: " W ?8,XD "RTN","RMPRFPRT",37,0) W @IOF "RTN","RMPRFPRT",38,0) D ^%ZISC "RTN","RMPRFPRT",39,0) Q "RTN","RMPRFPRT",40,0) HDR ; "RTN","RMPRFPRT",41,0) I PG,$E(IOST,1,2)="C-" S RMEND=$$EOP^ESPUTIL() Q:RMEND W @IOF "RTN","RMPRFPRT",42,0) E W @IOF "RTN","RMPRFPRT",43,0) S PG=PG+1 "RTN","RMPRFPRT",44,0) W !!,?23,"File 664/660 Field Length Errors",?70,"Page ",PG,! "RTN","RMPRFPRT",45,0) W !,"Originator=>> ",ORGN,! "RTN","RMPRFPRT",46,0) W !,?2,"IEN",?20,"Patient Name",?50,"IFCAP ORDER",! "RTN","RMPRFPRT",47,0) W !,?2,IEN,?20,$P(ERR,U,4),?50,$P(ERR,U,6),! "RTN","RMPRFPRT",48,0) Q "RTN","RMPRFPRT",49,0) WAIT ; "RTN","RMPRFPRT",50,0) ;Q:IO'=$G(IO("HOME")) "RTN","RMPRFPRT",51,0) N DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT "RTN","RMPRFPRT",52,0) W ! S DIR(0)="E" S DIR("A")="Enter RETURN to continue" D ^DIR W ! "RTN","RMPRFPRT",53,0) Q "VER") 8.0^22.0 "BLD",5964,6) ^98 **END** **END**